Theory CZH_UCAT_Introduction

(* Copyright 2021 (C) Mihails Milehins *)

section‹Introduction›
theory CZH_UCAT_Introduction
  imports CZH_Elementary_Categories.CZH_ECAT_Introduction
begin

text‹
This article provides a formalization of further elements of the 
theory of 1-categories without an additional structure.
More specifically, this article explores canonical universal
constructions \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/universal+construction}
} and their properties.
›

text‹\newpage›

end

Theory CZH_UCAT_Universal

(* Copyright 2021 (C) Mihails Milehins *)

section‹Universal arrow›
theory CZH_UCAT_Universal
  imports 
    CZH_UCAT_Introduction
    CZH_Elementary_Categories.CZH_ECAT_FUNCT
    CZH_Elementary_Categories.CZH_ECAT_Set
    CZH_Elementary_Categories.CZH_ECAT_Hom
begin



subsection‹Background›


text‹
The following section is based, primarily, on the elements of the content 
of Chapter III-1 in \cite{mac_lane_categories_2010}.
›



subsection‹Universal map›


text‹
The universal map is a convenience utility that allows treating 
a part of the definition of the universal arrow as an arrow in the
category ‹Set›.
›


subsubsection‹Definition and elementary properties›

definition umap_of :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "umap_of 𝔉 c r u d =
    [
      (λf'∈∘Hom (𝔉⦇HomDom⦈) r d. 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔉⦇HomCod⦈ u),
      Hom (𝔉⦇HomDom⦈) r d,
      Hom (𝔉⦇HomCod⦈) c (𝔉⦇ObjMap⦈⦇d⦈)
    ]∘"

definition umap_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "umap_fo 𝔉 c r u d = umap_of (op_cf 𝔉) c r u d"


text‹Components.›

lemma (in is_functor) umap_of_components:
  assumes "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈" (*do not remove*)
  shows "umap_of 𝔉 c r u d⦇ArrVal⦈ = (λf'∈∘Hom 𝔄 r d. 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 u)"
    and "umap_of 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 r d"
    and "umap_of 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
  unfolding umap_of_def arr_field_simps
  by (simp_all add: cat_cs_simps nat_omega_simps)

lemma (in is_functor) umap_fo_components:
  assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d⦇ArrVal⦈ = (λf'∈∘Hom 𝔄 d r. u ∘A𝔅 𝔉⦇ArrMap⦈⦇f'⦈)"
    and "umap_fo 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 d r"
    and "umap_fo 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
  unfolding 
    umap_fo_def 
    is_functor.umap_of_components[
      OF is_functor_op, unfolded cat_op_simps, OF assms
      ] 
proof(rule vsv_eqI)
  fix f' assume "f' ∈∘ 𝒟∘ (λf'∈∘Hom 𝔄 d r. 𝔉⦇ArrMap⦈⦇f'⦈ ∘Aop_cat 𝔅 u)"
  then have f': "f' : d ↦𝔄 r" by simp
  then have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇d⦈ ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈" 
    by (auto intro: cat_cs_intros)
  from f' show 
    "(λf'∈∘Hom 𝔄 d r. 𝔉⦇ArrMap⦈⦇f'⦈ ∘Aop_cat 𝔅 u)⦇f'⦈ = 
      (λf'∈∘Hom 𝔄 d r. u ∘A𝔅 𝔉⦇ArrMap⦈⦇f'⦈)⦇f'⦈"
    by (simp add: HomCod.op_cat_Comp[OF assms 𝔉f'])
qed simp_all


text‹Universal maps for the opposite functor.›

lemma (in is_functor) op_umap_of[cat_op_simps]: "umap_of (op_cf 𝔉) = umap_fo 𝔉"
  unfolding umap_fo_def by simp 

lemma (in is_functor) op_umap_fo[cat_op_simps]: "umap_fo (op_cf 𝔉) = umap_of 𝔉"
  unfolding umap_fo_def by (simp add: cat_op_simps)

lemmas [cat_op_simps] = 
  is_functor.op_umap_of
  is_functor.op_umap_fo


subsubsection‹Arrow value›

lemma umap_of_ArrVal_vsv[cat_cs_intros]: "vsv (umap_of 𝔉 c r u d⦇ArrVal⦈)"
  unfolding umap_of_def arr_field_simps by (simp add: nat_omega_simps)

lemma umap_fo_ArrVal_vsv[cat_cs_intros]: "vsv (umap_fo 𝔉 c r u d⦇ArrVal⦈)"
  unfolding umap_fo_def by (rule umap_of_ArrVal_vsv)

lemma (in is_functor) umap_of_ArrVal_vdomain: 
  assumes "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "𝒟∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 r d"
  unfolding umap_of_components[OF assms] by simp

lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_vdomain

lemma (in is_functor) umap_fo_ArrVal_vdomain:
  assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "𝒟∘ (umap_fo 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 d r"
  unfolding umap_fo_components[OF assms] by simp

lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_vdomain

lemma (in is_functor) umap_of_ArrVal_app: 
  assumes "f' : r ↦𝔄 d" and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "umap_of 𝔉 c r u d⦇ArrVal⦈⦇f'⦈ = 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 u"
  using assms(1) unfolding umap_of_components[OF assms(2)] by simp

lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_app

lemma (in is_functor) umap_fo_ArrVal_app: 
  assumes "f' : d ↦𝔄 r" and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d⦇ArrVal⦈⦇f'⦈ = u ∘A𝔅 𝔉⦇ArrMap⦈⦇f'⦈"
proof-
  from assms have "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇d⦈ ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈" 
    by (auto intro: cat_cs_intros)
  from this assms(2) have 𝔉f'[simp]:
    "𝔉⦇ArrMap⦈⦇f'⦈ ∘Aop_cat 𝔅 u = u ∘A𝔅 𝔉⦇ArrMap⦈⦇f'⦈"
    by (simp add: cat_op_simps)
  from
    is_functor_axioms
    is_functor.umap_of_ArrVal_app[
      OF is_functor_op, unfolded cat_op_simps, 
      OF assms
      ] 
  show ?thesis
    by (simp add: cat_op_simps cat_cs_simps)
qed

lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_app

lemma (in is_functor) umap_of_ArrVal_vrange: 
  assumes "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "ℛ∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) ⊆∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
proof(intro vsubset_antisym vsubsetI)
  interpret vsv ‹umap_of 𝔉 c r u d⦇ArrVal⦈› 
    unfolding umap_of_components[OF assms] by simp
  fix g assume "g ∈∘ ℛ∘ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
  then obtain f' 
    where g_def: "g = umap_of 𝔉 c r u d⦇ArrVal⦈⦇f'⦈" 
      and f': "f' ∈∘ 𝒟∘ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
    unfolding umap_of_components[OF assms] by auto
  then have f': "f' : r ↦𝔄 d" 
    unfolding umap_of_ArrVal_vdomain[OF assms] by simp
  then have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 𝔉⦇ObjMap⦈⦇d⦈" 
    by (auto intro!: cat_cs_intros)
  have g_def: "g = 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 u"
    unfolding g_def umap_of_ArrVal_app[OF f' assms]..
  from 𝔉f' assms show "g ∈∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)" 
    unfolding g_def by (auto intro: cat_cs_intros)
qed

lemma (in is_functor) umap_fo_ArrVal_vrange: 
  assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "ℛ∘ (umap_fo 𝔉 c r u d⦇ArrVal⦈) ⊆∘ Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
  by 
    (
      rule is_functor.umap_of_ArrVal_vrange[
        OF is_functor_op, unfolded cat_op_simps, OF assms, folded umap_fo_def
        ]
    )


subsubsection‹Universal map is an arrow in the category ‹Set››

lemma (in is_functor) cf_arr_Set_umap_of: 
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and r: "r ∈∘ 𝔄⦇Obj⦈" 
    and d: "d ∈∘ 𝔄⦇Obj⦈"
    and u: "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "arr_Set α (umap_of 𝔉 c r u d)"
proof(intro arr_SetI)
  interpret HomDom: category α 𝔄 by (rule assms(1))
  interpret HomCod: category α 𝔅 by (rule assms(2))
  note umap_of_components = umap_of_components[OF u]
  from u d have c: "c ∈∘ 𝔅⦇Obj⦈" and 𝔉d: "(𝔉⦇ObjMap⦈⦇d⦈) ∈∘ 𝔅⦇Obj⦈" 
    by (auto intro: cat_cs_intros)
  show "vfsequence (umap_of 𝔉 c r u d)" unfolding umap_of_def by simp
  show "vcard (umap_of 𝔉 c r u d) = 3ℕ"
    unfolding umap_of_def by (simp add: nat_omega_simps)
  from umap_of_ArrVal_vrange[OF u] show 
    "ℛ∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) ⊆∘ umap_of 𝔉 c r u d⦇ArrCod⦈"
    unfolding umap_of_components by simp
  from r d show "umap_of 𝔉 c r u d⦇ArrDom⦈ ∈∘ Vset α"
    unfolding umap_of_components by (intro HomDom.cat_Hom_in_Vset)
  from c 𝔉d show "umap_of 𝔉 c r u d⦇ArrCod⦈ ∈∘ Vset α"
    unfolding umap_of_components by (intro HomCod.cat_Hom_in_Vset)
qed (auto simp: umap_of_components[OF u])

lemma (in is_functor) cf_arr_Set_umap_fo: 
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and r: "r ∈∘ 𝔄⦇Obj⦈" 
    and d: "d ∈∘ 𝔄⦇Obj⦈"
    and u: "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "arr_Set α (umap_fo 𝔉 c r u d)"
proof-
  from assms(1) have 𝔄: "category α (op_cat 𝔄)" 
    by (auto intro: cat_cs_intros)
  from assms(2) have 𝔅: "category α (op_cat 𝔅)" 
    by (auto intro: cat_cs_intros)
  show ?thesis
    by 
      (
        rule 
          is_functor.cf_arr_Set_umap_of[
            OF is_functor_op, unfolded cat_op_simps, OF 𝔄 𝔅 r d u
            ]
      )
qed

lemma (in is_functor) cf_umap_of_is_arr:
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "umap_of 𝔉 c r u d : Hom 𝔄 r d ↦cat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
proof(intro cat_Set_is_arrI)
  show "arr_Set α (umap_of 𝔉 c r u d)" 
    by (rule cf_arr_Set_umap_of[OF assms])
qed (simp_all add: umap_of_components[OF assms(5)])

lemma (in is_functor) cf_umap_of_is_arr':
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
    and "A = Hom 𝔄 r d"
    and "B = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
    and "ℭ = cat_Set α"
  shows "umap_of 𝔉 c r u d : A ↦ℭ B"
  using assms(1-5) unfolding assms(6-8) by (rule cf_umap_of_is_arr)

lemmas [cat_cs_intros] = is_functor.cf_umap_of_is_arr'

lemma (in is_functor) cf_umap_fo_is_arr:
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d : Hom 𝔄 d r ↦cat_Set α Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
proof(intro cat_Set_is_arrI)
  show "arr_Set α (umap_fo 𝔉 c r u d)" 
    by (rule cf_arr_Set_umap_fo[OF assms])
qed (simp_all add: umap_fo_components[OF assms(5)])

lemma (in is_functor) cf_umap_fo_is_arr':
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
    and "A = Hom 𝔄 d r"
    and "B = Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
    and "ℭ = cat_Set α"
  shows "umap_fo 𝔉 c r u d : A ↦ℭ B"
  using assms(1-5) unfolding assms(6-8) by (rule cf_umap_fo_is_arr)

lemmas [cat_cs_intros] = is_functor.cf_umap_fo_is_arr'



subsection‹Universal arrow: definition and elementary properties›


text‹See Chapter III-1 in \cite{mac_lane_categories_2010}.›

definition universal_arrow_of :: "V ⇒ V ⇒ V ⇒ V ⇒ bool"
  where "universal_arrow_of 𝔉 c r u ⟷
    (
      r ∈∘ 𝔉⦇HomDom⦈⦇Obj⦈ ∧
      u : c ↦𝔉⦇HomCod⦈ 𝔉⦇ObjMap⦈⦇r⦈ ∧
      (
        ∀r' u'.
          r' ∈∘ 𝔉⦇HomDom⦈⦇Obj⦈ ⟶
          u' : c ↦𝔉⦇HomCod⦈ 𝔉⦇ObjMap⦈⦇r'⦈ ⟶
          (∃!f'. f' : r ↦𝔉⦇HomDom⦈ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈)
      )
    )"

definition universal_arrow_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ bool"
  where "universal_arrow_fo 𝔉 c r u ≡ universal_arrow_of (op_cf 𝔉) c r u"


text‹Rules.›

mk_ide (in is_functor) rf 
  universal_arrow_of_def[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]
  |intro universal_arrow_ofI|
  |dest universal_arrow_ofD[dest]|
  |elim universal_arrow_ofE[elim]|

lemma (in is_functor) universal_arrow_foI:
  assumes "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c" 
    and "⋀r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦𝔅 c ⟧ ⟹ 
      ∃!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
  shows "universal_arrow_fo 𝔉 c r u"
  by 
    (
      simp add: 
        is_functor.universal_arrow_ofI
          [
            OF is_functor_op, 
            folded universal_arrow_fo_def, 
            unfolded cat_op_simps, 
            OF assms
          ]
    )

lemma (in is_functor) universal_arrow_foD[dest]:
  assumes "universal_arrow_fo 𝔉 c r u"
  shows "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c" 
    and "⋀r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦𝔅 c ⟧ ⟹ 
      ∃!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
  by
    (
      auto simp: 
        is_functor.universal_arrow_ofD
          [
            OF is_functor_op, 
            folded universal_arrow_fo_def, 
            unfolded cat_op_simps,
            OF assms
          ]
    )

lemma (in is_functor) universal_arrow_foE[elim]:
  assumes "universal_arrow_fo 𝔉 c r u"
  obtains "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c" 
    and "⋀r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦𝔅 c ⟧ ⟹ 
      ∃!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
  using assms by (auto simp: universal_arrow_foD)


text‹Elementary properties.›

lemma (in is_functor) op_cf_universal_arrow_of[cat_op_simps]: 
  "universal_arrow_of (op_cf 𝔉) c r u ⟷ universal_arrow_fo 𝔉 c r u"
  unfolding universal_arrow_fo_def ..

lemma (in is_functor) op_cf_universal_arrow_fo[cat_op_simps]: 
  "universal_arrow_fo (op_cf 𝔉) c r u ⟷ universal_arrow_of 𝔉 c r u"
  unfolding universal_arrow_fo_def cat_op_simps ..

lemmas (in is_functor) [cat_op_simps] = 
  is_functor.op_cf_universal_arrow_of
  is_functor.op_cf_universal_arrow_fo



subsection‹Uniqueness›


text‹
The following properties are related to the uniqueness of the 
universal arrow. These properties can be inferred from the content of
Chapter III-1 in \cite{mac_lane_categories_2010}.
›

lemma (in is_functor) cf_universal_arrow_of_ex_is_arr_isomorphism:
  ―‹The proof is based on the ideas expressed in the proof of Theorem 5.2 
  in Chapter Introduction in \cite{hungerford_algebra_2003}.›
  assumes "universal_arrow_of 𝔉 c r u" and "universal_arrow_of 𝔉 c r' u'"
  obtains f where "f : r ↦iso𝔄 r'" and "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
proof-

  note ua1 = universal_arrow_ofD[OF assms(1)]
  note ua2 = universal_arrow_ofD[OF assms(2)]

  from ua1(1) have 𝔄r: "𝔄⦇CId⦈⦇r⦈ : r ↦𝔄 r" by (auto intro: cat_cs_intros)
  from ua1(1) have "𝔉⦇ArrMap⦈⦇𝔄⦇CId⦈⦇r⦈⦈ = 𝔅⦇CId⦈⦇𝔉⦇ObjMap⦈⦇r⦈⦈"
    by (auto intro: cat_cs_intros)
  with ua1(1,2) have u_def: "u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
    unfolding umap_of_ArrVal_app[OF 𝔄r ua1(2)] by (auto simp: cat_cs_simps)

  from ua2(1) have 𝔄r': "𝔄⦇CId⦈⦇r'⦈ : r' ↦𝔄 r'" by (auto intro: cat_cs_intros)
  from ua2(1) have "𝔉⦇ArrMap⦈⦇𝔄⦇CId⦈⦇r'⦈⦈ = 𝔅⦇CId⦈⦇𝔉⦇ObjMap⦈⦇r'⦈⦈" 
    by (auto intro: cat_cs_intros)
  with ua2(1,2) have u'_def: "u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r'⦈⦈"
    unfolding umap_of_ArrVal_app[OF 𝔄r' ua2(2)] by (auto simp: cat_cs_simps)

  from 𝔄r u_def universal_arrow_ofD(3)[OF assms(1) ua1(1,2)] have eq_CId_rI: 
    "⟦ f' : r ↦𝔄 r; u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇f'⦈ ⟧ ⟹ f' = 𝔄⦇CId⦈⦇r⦈" 
    for f'
    by blast
  from 𝔄r' u'_def universal_arrow_ofD(3)[OF assms(2) ua2(1,2)] have eq_CId_r'I: 
    "⟦ f' : r' ↦𝔄 r'; u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇f'⦈ ⟧ ⟹
      f' = 𝔄⦇CId⦈⦇r'⦈" 
    for f'
    by blast

  from ua1(3)[OF ua2(1,2)] obtain f 
    where f: "f : r ↦𝔄 r'" 
      and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
      and "g : r ↦𝔄 r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇g⦈ ⟹ f = g" 
    for g
    by metis
  from ua2(3)[OF ua1(1,2)] obtain f' 
    where f': "f' : r' ↦𝔄 r" 
      and u_def: "u = umap_of 𝔉 c r' u' r⦇ArrVal⦈⦇f'⦈"
      and "g : r' ↦𝔄 r ⟹ u = umap_of 𝔉 c r' u' r⦇ArrVal⦈⦇g⦈ ⟹ f' = g" 
    for g
    by metis

  have "f : r ↦iso𝔄 r'"
  proof(intro is_arr_isomorphismI is_inverseI)
    show f: "f : r ↦𝔄 r'" by (rule f)
    show f': "f' : r' ↦𝔄 r" by (rule f')
    show "f : r ↦𝔄 r'" by (rule f)
    from f' have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇r'⦈ ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈" 
      by (auto intro: cat_cs_intros)
    from f have 𝔉f: "𝔉⦇ArrMap⦈⦇f⦈ : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 𝔉⦇ObjMap⦈⦇r'⦈" 
      by (auto intro: cat_cs_intros)
    note u'_def' = u'_def[symmetric, unfolded umap_of_ArrVal_app[OF f ua1(2)]] 
      and u_def' = u_def[symmetric, unfolded umap_of_ArrVal_app[OF f' ua2(2)]]
    show "f' ∘A𝔄 f = 𝔄⦇CId⦈⦇r⦈"
    proof(rule eq_CId_rI)
      from f f' show f'f: "f' ∘A𝔄 f : r ↦𝔄 r" 
        by (auto intro: cat_cs_intros)
      from ua1(2) 𝔉f' 𝔉f show "u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇f' ∘A𝔄 f⦈"
        unfolding umap_of_ArrVal_app[OF f'f ua1(2)] cf_ArrMap_Comp[OF f' f]
        by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
    qed
    show "f ∘A𝔄 f' = 𝔄⦇CId⦈⦇r'⦈"
    proof(rule eq_CId_r'I)
      from f f' show ff': "f ∘A𝔄 f' : r' ↦𝔄 r'" 
        by (auto intro: cat_cs_intros)
      from ua2(2) 𝔉f' 𝔉f show "u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇f ∘A𝔄 f'⦈"
        unfolding umap_of_ArrVal_app[OF ff' ua2(2)] cf_ArrMap_Comp[OF f f']
        by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
    qed
  qed
  
  with u'_def that show ?thesis by auto

qed

lemma (in is_functor) cf_universal_arrow_fo_ex_is_arr_isomorphism:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
  obtains f where "f : r' ↦iso𝔄 r" and "u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
  by 
    (
      elim 
        is_functor.cf_universal_arrow_of_ex_is_arr_isomorphism[
          OF is_functor_op, unfolded cat_op_simps, OF assms
          ]
    )

lemma (in is_functor) cf_universal_arrow_of_unique:
  assumes "universal_arrow_of 𝔉 c r u"
    and "universal_arrow_of 𝔉 c r' u'"
  shows "∃!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
proof-
  note ua1 = universal_arrow_ofD[OF assms(1)]
  note ua2 = universal_arrow_ofD[OF assms(2)]
  from ua1(3)[OF ua2(1,2)] show ?thesis .
qed

lemma (in is_functor) cf_universal_arrow_fo_unique:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
  shows "∃!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
proof-
  note ua1 = universal_arrow_foD[OF assms(1)]
  note ua2 = universal_arrow_foD[OF assms(2)]
  from ua1(3)[OF ua2(1,2)] show ?thesis .
qed

lemma (in is_functor) cf_universal_arrow_of_is_arr_isomorphism:
  assumes "universal_arrow_of 𝔉 c r u"
    and "universal_arrow_of 𝔉 c r' u'"
    and "f : r ↦𝔄 r'" 
    and "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
  shows "f : r ↦iso𝔄 r'"
proof-
  from assms(3,4) cf_universal_arrow_of_unique[OF assms(1,2)] have eq: 
    "g : r ↦𝔄 r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇g⦈ ⟹ f = g" for g
    by blast
  from assms(1,2) obtain f' 
    where iso_f': "f' : r ↦iso𝔄 r'" 
      and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
    by (auto elim: cf_universal_arrow_of_ex_is_arr_isomorphism)
  then have f': "f' : r ↦𝔄 r'" by auto
  from iso_f' show ?thesis unfolding eq[OF f' u'_def, symmetric].
qed

lemma (in is_functor) cf_universal_arrow_fo_is_arr_isomorphism:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
    and "f : r' ↦𝔄 r" 
    and "u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
  shows "f : r' ↦iso𝔄 r"
  by 
    (
      rule 
        is_functor.cf_universal_arrow_of_is_arr_isomorphism[
          OF is_functor_op, unfolded cat_op_simps, OF assms
          ]
    )



subsection‹Universal natural transformation›


subsubsection‹Definition and elementary properties›


text‹
The concept of the universal natural transformation is introduced for the 
statement of the elements of a variant of Proposition 1 in Chapter III-2
in \cite{mac_lane_categories_2010}.
›

definition ntcf_ua_of :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_ua_of α 𝔉 c r u =
    [
      (λd∈∘𝔉⦇HomDom⦈⦇Obj⦈. umap_of 𝔉 c r u d),
      HomO.Cα𝔉⦇HomDom⦈(r,-),
      HomO.Cα𝔉⦇HomCod⦈(c,-) ∘CF 𝔉,
      𝔉⦇HomDom⦈,
      cat_Set α
    ]∘"

definition ntcf_ua_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_ua_fo α 𝔉 c r u = ntcf_ua_of α (op_cf 𝔉) c r u"


text‹Components.›

lemma ntcf_ua_of_components:
  shows "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈ = (λd∈∘𝔉⦇HomDom⦈⦇Obj⦈. umap_of 𝔉 c r u d)"
    and "ntcf_ua_of α 𝔉 c r u⦇NTDom⦈ = HomO.Cα𝔉⦇HomDom⦈(r,-)"
    and "ntcf_ua_of α 𝔉 c r u⦇NTCod⦈ = HomO.Cα𝔉⦇HomCod⦈(c,-) ∘CF 𝔉"
    and "ntcf_ua_of α 𝔉 c r u⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
    and "ntcf_ua_of α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_ua_of_def nt_field_simps by (simp_all add: nat_omega_simps) 

lemma ntcf_ua_fo_components:
  shows "ntcf_ua_fo α 𝔉 c r u⦇NTMap⦈ = (λd∈∘𝔉⦇HomDom⦈⦇Obj⦈. umap_fo 𝔉 c r u d)"
    and "ntcf_ua_fo α 𝔉 c r u⦇NTDom⦈ = HomO.Cαop_cat (𝔉⦇HomDom⦈)(r,-)"
    and "ntcf_ua_fo α 𝔉 c r u⦇NTCod⦈ =
      HomO.Cαop_cat (𝔉⦇HomCod⦈)(c,-) ∘CF op_cf 𝔉"
    and "ntcf_ua_fo α 𝔉 c r u⦇NTDGDom⦈ = op_cat (𝔉⦇HomDom⦈)"
    and "ntcf_ua_fo α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_ua_fo_def ntcf_ua_of_components umap_fo_def cat_op_simps 
  by simp_all

context is_functor
begin

lemmas ntcf_ua_of_components' = 
  ntcf_ua_of_components[where α=α and 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_cs_simps] = ntcf_ua_of_components'(2-5)

lemma ntcf_ua_fo_components':
  assumes "c ∈∘ 𝔅⦇Obj⦈" and "r ∈∘ 𝔄⦇Obj⦈" 
  shows "ntcf_ua_fo α 𝔉 c r u⦇NTMap⦈ = (λd∈∘𝔄⦇Obj⦈. umap_fo 𝔉 c r u d)"
    and [cat_cs_simps]: 
      "ntcf_ua_fo α 𝔉 c r u⦇NTDom⦈ = HomO.Cα𝔄(-,r)"
    and [cat_cs_simps]: 
      "ntcf_ua_fo α 𝔉 c r u⦇NTCod⦈ = HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉"
    and [cat_cs_simps]: "ntcf_ua_fo α 𝔉 c r u⦇NTDGDom⦈ = op_cat 𝔄"
    and [cat_cs_simps]: "ntcf_ua_fo α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
  unfolding
    ntcf_ua_fo_components cat_cs_simps
    HomDom.cat_op_cat_cf_Hom_snd[OF assms(2)] 
    HomCod.cat_op_cat_cf_Hom_snd[OF assms(1)]
  by simp_all

end

lemmas [cat_cs_simps] = 
  is_functor.ntcf_ua_of_components'(2-5)
  is_functor.ntcf_ua_fo_components'(2-5)


subsubsection‹Natural transformation map›

mk_VLambda (in is_functor) 
  ntcf_ua_of_components(1)[where α=α and 𝔉=𝔉, unfolded cf_HomDom]
  |vsv ntcf_ua_of_NTMap_vsv|
  |vdomain ntcf_ua_of_NTMap_vdomain|
  |app ntcf_ua_of_NTMap_app|

context is_functor
begin

context
  fixes c r
  assumes r: "r ∈∘ 𝔄⦇Obj⦈" and c: "c ∈∘ 𝔅⦇Obj⦈" 
begin

mk_VLambda ntcf_ua_fo_components'(1)[OF c r]
  |vsv ntcf_ua_fo_NTMap_vsv|
  |vdomain ntcf_ua_fo_NTMap_vdomain|
  |app ntcf_ua_fo_NTMap_app|

end

end

lemmas [cat_cs_intros] = 
  is_functor.ntcf_ua_fo_NTMap_vsv
  is_functor.ntcf_ua_of_NTMap_vsv

lemmas [cat_cs_simps] = 
  is_functor.ntcf_ua_fo_NTMap_vdomain
  is_functor.ntcf_ua_fo_NTMap_app
  is_functor.ntcf_ua_of_NTMap_vdomain
  is_functor.ntcf_ua_of_NTMap_app

lemma (in is_functor) ntcf_ua_of_NTMap_vrange:
  assumes "category α 𝔄" 
    and "category α 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "ℛ∘ (ntcf_ua_of α 𝔉 c r u⦇NTMap⦈) ⊆∘ cat_Set α⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold ntcf_ua_of_NTMap_vdomain)
  show "vsv (ntcf_ua_of α 𝔉 c r u⦇NTMap⦈)" by (rule ntcf_ua_of_NTMap_vsv)
  fix d assume prems: "d ∈∘ 𝔄⦇Obj⦈"
  with category_cat_Set is_functor_axioms assms show 
    "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇d⦈ ∈∘ cat_Set α⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed


subsubsection‹Commutativity of the universal maps and ‹hom›-functions›

lemma (in is_functor) cf_umap_of_cf_hom_commute: 
  assumes "category α 𝔄"
    and "category α 𝔅"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
    and "f : a ↦𝔄 b"
  shows 
    "umap_of 𝔉 c r u b ∘Acat_Set α cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f]∘ =
      cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f⦈]∘ ∘Acat_Set α umap_of 𝔉 c r u a"
  (is ‹?uof_b ∘Acat_Set α ?rf = ?cf ∘Acat_Set α ?uof_a›)
proof-

  from is_functor_axioms category_cat_Set assms(1,2,4-6) have b_rf: 
    "?uof_b ∘Acat_Set α ?rf : Hom 𝔄 r a ↦cat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇b⦈)"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
  from is_functor_axioms category_cat_Set assms(1,2,4-6) have cf_a: 
    "?cf ∘Acat_Set α ?uof_a : Hom 𝔄 r a ↦cat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇b⦈)"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from b_rf show arr_Set_b_rf: "arr_Set α (?uof_b ∘Acat_Set α ?rf)"
      by (auto dest: cat_Set_is_arrD(1))
    from b_rf have dom_lhs: 
      "𝒟∘ ((?uof_b ∘Acat_Set α ?rf)⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)+
    from cf_a show arr_Set_cf_a: "arr_Set α (?cf ∘Acat_Set α ?uof_a)"
      by (auto dest: cat_Set_is_arrD(1))
    from cf_a have dom_rhs: 
      "𝒟∘ ((?cf ∘Acat_Set α ?uof_a)⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)
    show "(?uof_b ∘Acat_Set α ?rf)⦇ArrVal⦈ = (?cf ∘Acat_Set α ?uof_a)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix q assume "q : r ↦𝔄 a"
      with is_functor_axioms category_cat_Set assms show 
        "(?uof_b ∘Acat_Set α ?rf)⦇ArrVal⦈⦇q⦈ =
          (?cf ∘Acat_Set α ?uof_a)⦇ArrVal⦈⦇q⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
    qed (use arr_Set_b_rf arr_Set_cf_a in auto)
  
  qed (use b_rf cf_a in ‹cs_concl cs_simp: cat_cs_simps›)+

qed

lemma cf_umap_of_cf_hom_unit_commute:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    and "g : c' ↦ℭ c" 
    and "f : d ↦𝔇 d'"
  shows 
    "umap_of 𝔊 c' (𝔉⦇ObjMap⦈⦇c'⦈) (η⦇NTMap⦈⦇c'⦈) d' ∘Acat_Set α
      cf_hom 𝔇 [𝔉⦇ArrMap⦈⦇g⦈, f]∘ =
        cf_hom ℭ [g, 𝔊⦇ArrMap⦈⦇f⦈]∘ ∘Acat_Set α
          umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
  (is ‹?uof_c'd' ∘Acat_Set α ?𝔉gf = ?g𝔊f ∘Acat_Set α ?uof_cd›)
proof-

  interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› η by (rule assms(5))

  from assms have c'd'_𝔉gf: "?uof_c'd' ∘Acat_Set α ?𝔉gf :
    Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d ↦cat_Set α Hom ℭ c' (𝔊⦇ObjMap⦈⦇d'⦈)"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_lhs:
    "𝒟∘ ((?uof_c'd' ∘Acat_Set α ?𝔉gf)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms have g𝔊f_cd: "?g𝔊f ∘Acat_Set α ?uof_cd :
    Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d ↦cat_Set α Hom ℭ c' (𝔊⦇ObjMap⦈⦇d'⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_rhs: 
    "𝒟∘ ((?g𝔊f ∘Acat_Set α ?uof_cd)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from c'd'_𝔉gf show arr_Set_c'd'_𝔉gf: 
      "arr_Set α (?uof_c'd' ∘Acat_Set α ?𝔉gf)"
      by (auto dest: cat_Set_is_arrD(1))
    from g𝔊f_cd show arr_Set_g𝔊f_cd:
      "arr_Set α (?g𝔊f ∘Acat_Set α ?uof_cd)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(?uof_c'd' ∘Acat_Set α ?𝔉gf)⦇ArrVal⦈ =
        (?g𝔊f ∘Acat_Set α ?uof_cd)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume prems: "h : 𝔉⦇ObjMap⦈⦇c⦈ ↦𝔇 d"
      from η.ntcf_Comp_commute[OF assms(6)] assms have [cat_cs_simps]:
        "η⦇NTMap⦈⦇c⦈ ∘Aℭ g = 𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇g⦈⦈ ∘Aℭ η⦇NTMap⦈⦇c'⦈"
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      from assms prems show 
        "(?uof_c'd' ∘Acat_Set α ?𝔉gf)⦇ArrVal⦈⦇h⦈ =
          (?g𝔊f ∘Acat_Set α ?uof_cd)⦇ArrVal⦈⦇h⦈"
        by 
          (
            cs_concl
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros  
              cs_simp: cat_cs_simps
          )
    qed (use arr_Set_c'd'_𝔉gf arr_Set_g𝔊f_cd in auto)
 
  qed (use c'd'_𝔉gf g𝔊f_cd in ‹cs_concl cs_simp: cat_cs_simps›)+

qed


subsubsection‹Universal natural transformation is a natural transformation›

lemma (in is_functor) cf_ntcf_ua_of_is_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
  shows "ntcf_ua_of α 𝔉 c r u :
    HomO.Cα𝔄(r,-) ↦CF HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦Cα cat_Set α"
proof(intro is_ntcfI')
  let ?ua = ‹ntcf_ua_of α 𝔉 c r u›
  show "vfsequence (ntcf_ua_of α 𝔉 c r u)" unfolding ntcf_ua_of_def by simp
  show "vcard ?ua = 5ℕ" unfolding ntcf_ua_of_def by (simp add: nat_omega_simps)
  from assms(1) show "HomO.Cα𝔄(r,-) : 𝔄 ↦↦Cα cat_Set α"
    by (cs_concl cs_intro: cat_cs_intros)
  from is_functor_axioms assms(2) show 
    "HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦Cα cat_Set α"
    by (cs_concl cs_intro: cat_cs_intros)
  from is_functor_axioms assms show "𝒟∘ (?ua⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "?ua⦇NTMap⦈⦇a⦈ :
    HomO.Cα𝔄(r,-)⦇ObjMap⦈⦇a⦈ ↦cat_Set α (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMap⦈⦇a⦈"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using is_functor_axioms assms that 
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  show "?ua⦇NTMap⦈⦇b⦈ ∘Acat_Set α HomO.Cα𝔄(r,-)⦇ArrMap⦈⦇f⦈ =
    (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ArrMap⦈⦇f⦈ ∘Acat_Set α ?ua⦇NTMap⦈⦇a⦈"
    if "f : a ↦𝔄 b" for a b f
    using is_functor_axioms assms that 
    by 
      ( 
        cs_concl 
          cs_simp: cf_umap_of_cf_hom_commute cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )
qed (auto simp: ntcf_ua_of_components cat_cs_simps)

lemma (in is_functor) cf_ntcf_ua_fo_is_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈" and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
  shows "ntcf_ua_fo α 𝔉 c r u :
    HomO.Cα𝔄(-,r) ↦CF HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
    op_cat 𝔄 ↦↦Cα cat_Set α"
proof-
  from assms(2) have c: "c ∈∘ 𝔅⦇Obj⦈" by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_of_is_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps, 
            OF assms(1,2),
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric]
          ]
      )
qed


subsubsection‹Universal natural transformation and universal arrow›


text‹
The lemmas in this subsection correspond to 
variants of elements of Proposition 1 in Chapter III-2 in 
\cite{mac_lane_categories_2010}.
›

lemma (in is_functor) cf_ntcf_ua_of_is_iso_ntcf:
  assumes "universal_arrow_of 𝔉 c r u"
  shows "ntcf_ua_of α 𝔉 c r u :
    HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦Cα cat_Set α"
proof-

  have r: "r ∈∘ 𝔄⦇Obj⦈"
    and u: "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
    and bij: "⋀r' u'.
      ⟦
        r' ∈∘ 𝔄⦇Obj⦈; 
        u' : c ↦𝔅 𝔉⦇ObjMap⦈⦇r'⦈
      ⟧ ⟹ ∃!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
    by (auto intro!: universal_arrow_ofD[OF assms(1)])

  show ?thesis
  proof(intro is_iso_ntcfI)
    show "ntcf_ua_of α 𝔉 c r u :
      HomO.Cα𝔄(r,-) ↦CF HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦Cα cat_Set α"
      by (rule cf_ntcf_ua_of_is_ntcf[OF r u])
    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    from is_functor_axioms prems r u have [simp]:
      "umap_of 𝔉 c r u a : Hom 𝔄 r a ↦cat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
      by (cs_concl cs_intro: cat_cs_intros)
    then have dom: "𝒟∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)
    have "umap_of 𝔉 c r u a : Hom 𝔄 r a ↦isocat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
    proof(intro cat_Set_is_arr_isomorphismI, unfold dom)
 
      show umof_a: "v11 (umap_of 𝔉 c r u a⦇ArrVal⦈)"
      proof(intro vsv.vsv_valeq_v11I, unfold dom in_Hom_iff)
        fix g f assume prems': 
          "g : r ↦𝔄 a"
          "f : r ↦𝔄 a" 
          "umap_of 𝔉 c r u a⦇ArrVal⦈⦇g⦈ = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f⦈"
        from is_functor_axioms r u prems'(1) have 𝔉g:
          "𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔅 u : c ↦𝔅 𝔉⦇ObjMap⦈⦇a⦈"
          by (cs_concl cs_intro: cat_cs_intros)
        from bij[OF prems 𝔉g] have unique:
          "⟦
            f' : r ↦𝔄 a;
            𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔅 u = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f'⦈ 
           ⟧ ⟹ g = f'"
          for f' by (metis prems'(1) u umap_of_ArrVal_app)
        from is_functor_axioms prems'(1,2) u have 𝔉g_u:
          "𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔅 u = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f⦈"
          by (cs_concl cs_simp: prems'(3)[symmetric] cat_cs_simps)
        show "g = f" by (rule unique[OF prems'(2) 𝔉g_u])
      qed (auto simp: cat_cs_simps cat_cs_intros)

      interpret umof_a: v11 ‹umap_of 𝔉 c r u a⦇ArrVal⦈› by (rule umof_a)

      show "ℛ∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
      proof(intro vsubset_antisym)
        from u show "ℛ∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) ⊆∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
          by (rule umap_of_ArrVal_vrange)
        show "Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈) ⊆∘ ℛ∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
        proof(rule vsubsetI, unfold in_Hom_iff )
          fix f assume prems': "f : c ↦𝔅 𝔉⦇ObjMap⦈⦇a⦈"
          from bij[OF prems prems'] obtain f' 
            where f': "f' : r ↦𝔄 a" 
              and f_def: "f = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f'⦈"
            by auto
          from is_functor_axioms prems prems' u f' have 
            "f' ∈∘ 𝒟∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          from this show "f ∈∘ ℛ∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
            unfolding f_def by (rule umof_a.vsv_vimageI2)
        qed

      qed

    qed simp_all

    from is_functor_axioms prems r u this show 
      "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇a⦈ :
        HomO.Cα𝔄(r,-)⦇ObjMap⦈⦇a⦈ ↦isocat_Set α
        (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMap⦈⦇a⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros
        )
  qed

qed

lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_of_is_iso_ntcf

lemma (in is_functor) cf_ntcf_ua_fo_is_iso_ntcf:
  assumes "universal_arrow_fo 𝔉 c r u"
  shows "ntcf_ua_fo α 𝔉 c r u :
    HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
    op_cat 𝔄 ↦↦Cα cat_Set α"
proof-
  from universal_arrow_foD[OF assms] have r: "r ∈∘ 𝔄⦇Obj⦈" and c: "c ∈∘ 𝔅⦇Obj⦈"
    by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_of_is_iso_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps, 
            OF assms,
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF r] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric]
          ]
      ) 
qed

lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_fo_is_iso_ntcf

lemma (in is_functor) cf_ua_of_if_ntcf_ua_of_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
    and "ntcf_ua_of α 𝔉 c r u :
      HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦Cα cat_Set α"
  shows "universal_arrow_of 𝔉 c r u"
proof(rule universal_arrow_ofI)
  interpret ua_of_u: is_iso_ntcf 
    α 
    𝔄 
    ‹cat_Set α›
    ‹HomO.Cα𝔄(r,-)› 
    ‹HomO.Cα𝔅(c,-) ∘CF 𝔉› 
    ‹ntcf_ua_of α 𝔉 c r u›
    by (rule assms(3))
  fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMap⦈⦇r'⦈"  
  have "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇r'⦈ :
    HomO.Cα𝔄(r,-)⦇ObjMap⦈⦇r'⦈ ↦isocat_Set α
    (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMap⦈⦇r'⦈"
    by (rule is_iso_ntcf.iso_ntcf_is_arr_isomorphism[OF assms(3) prems(1)])
  from this is_functor_axioms assms(1-2) prems have uof_r':
    "umap_of 𝔉 c r u r' : Hom 𝔄 r r' ↦isocat_Set α Hom 𝔅 c (𝔉⦇ObjMap⦈⦇r'⦈)"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
  note uof_r' = cat_Set_is_arr_isomorphismD[OF uof_r']  
  interpret uof_r': v11 ‹umap_of 𝔉 c r u r'⦇ArrVal⦈› by (rule uof_r'(2))  
  from 
    uof_r'.v11_vrange_ex1_eq[
      THEN iffD1, unfolded uof_r'(3,4) in_Hom_iff, OF prems(2)
      ] 
  show "∃!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
    by metis
qed (intro assms)+

lemma (in is_functor) cf_ua_fo_if_ntcf_ua_fo_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦𝔅 c"
    and "ntcf_ua_fo α 𝔉 c r u :
      HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦Cα cat_Set α"
  shows "universal_arrow_fo 𝔉 c r u"
proof-
  from assms(2) have c: "c ∈∘ 𝔅⦇Obj⦈" by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps,
            OF assms(1,2),
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric],
            OF assms(3)
          ]
      )
qed

lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "φ :
      HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 :
      𝔄 ↦↦Cα cat_Set α"
  shows "universal_arrow_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
    (is ‹universal_arrow_of 𝔉 c r ?u›)
proof-

  interpret φ: is_iso_ntcf 
    α 𝔄 ‹cat_Set α› ‹HomO.Cα𝔄(r,-)› ‹HomO.Cα𝔅(c,-) ∘CF 𝔉› φ
    by (rule assms(3))

  show ?thesis
  proof(intro universal_arrow_ofI assms)
 
    from assms(1,2) show u: "?u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMap⦈⦇r'⦈"
    have φr'_ArrVal_app[symmetric, cat_cs_simps]:
      "φ⦇NTMap⦈⦇r'⦈⦇ArrVal⦈⦇f'⦈ =
        𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
      if "f' : r ↦𝔄 r'" for f'
    proof-
      have "φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set α HomO.Cα𝔄(r,-)⦇ArrMap⦈⦇f'⦈ =
        (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ArrMap⦈⦇f'⦈ ∘Acat_Set α φ⦇NTMap⦈⦇r⦈"
        using that by (intro φ.ntcf_Comp_commute)
      then have 
        "φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set α cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']∘ =
          cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]∘ ∘Acat_Set α φ⦇NTMap⦈⦇r⦈" 
        using assms(1,2) that prems
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      then have
        "(φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set α
        cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']∘)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈ =
          (cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]∘ ∘Acat_Set α
          φ⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
         by simp
      from this assms(1,2) u that show ?thesis
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed 
    
    show "∃!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms prems show 
        "(φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set α⦇ArrVal⦈⦇u'⦈ : r ↦𝔄 r'"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
      with assms(1,2) prems show "u' =
        umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇(φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set α⦇ArrVal⦈⦇u'⦈⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )
      fix f' assume prems': 
        "f' : r ↦𝔄 r'"
        "u' = umap_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈) r'⦇ArrVal⦈⦇f'⦈"
      from prems'(2,1) assms(1,2) have u'_def: 
        "u' = 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      from prems' show "f' = (φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set α⦇ArrVal⦈⦇u'⦈"
        unfolding u'_def φr'_ArrVal_app[OF prems'(1)]
        by
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "φ :
      HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦Cα cat_Set α"
  shows "universal_arrow_fo 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
  by
    (
      rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf
        [
          OF is_functor_op,
          unfolded cat_op_simps,
          OF assms(1,2),
          unfolded 
            HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
            HomCod.cat_op_cat_cf_Hom_snd[OF assms(2)]
            ntcf_ua_fo_def[symmetric],
          OF assms(3)
        ]
  )

lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "φ :
      HomO.Cβ𝔄(r,-) ↦CF.iso HomO.Cβ𝔅(c,-) ∘CF 𝔉 :
      𝔄 ↦↦Cβ cat_Set β"
  shows "universal_arrow_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
    (is ‹universal_arrow_of 𝔉 c r ?u›)
proof-

  interpret β: 𝒵 β by (rule assms(1))
  interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
    by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
  interpret φ: is_iso_ntcf 
    β 𝔄 ‹cat_Set β› ‹HomO.Cβ𝔄(r,-)› ‹HomO.Cβ𝔅(c,-) ∘CF 𝔉› φ
    by (rule assms(5))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
  interpret β𝔉: is_functor β 𝔄 𝔅 𝔉
    by (rule cf_is_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+

  show ?thesis
  proof(intro universal_arrow_ofI assms)
 
    from assms(3,4) show u: "?u : c ↦𝔅 𝔉⦇ObjMap⦈⦇r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMap⦈⦇r'⦈"
    have φr'_ArrVal_app[symmetric, cat_cs_simps]:
      "φ⦇NTMap⦈⦇r'⦈⦇ArrVal⦈⦇f'⦈ =
        𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
      if "f' : r ↦𝔄 r'" for f'
    proof-
      have "φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set β HomO.Cβ𝔄(r,-)⦇ArrMap⦈⦇f'⦈ =
        (HomO.Cβ𝔅(c,-) ∘CF 𝔉)⦇ArrMap⦈⦇f'⦈ ∘Acat_Set β φ⦇NTMap⦈⦇r⦈"
        using that by (intro φ.ntcf_Comp_commute)
      then have 
        "φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set β cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']∘ =
          cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]∘ ∘Acat_Set β φ⦇NTMap⦈⦇r⦈" 
        using assms(3,4) assms(1,2) that prems
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      then have
        "(φ⦇NTMap⦈⦇r'⦈ ∘Acat_Set β
        cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']∘)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈ =
          (cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]∘ ∘Acat_Set β
          φ⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
        by simp
      from 
        this assms(3,4,2) u that HomDom.category_axioms HomCod.category_axioms
      show ?thesis
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro:
                cat_cs_intros
                cat_op_intros
                cat_prod_cs_intros
                cat_Set_αβ.subcat_is_arrD
          )
    qed 
    
    show "∃!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms prems HomDom.category_axioms show 
        "(φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set β⦇ArrVal⦈⦇u'⦈ : r ↦𝔄 r'"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
      with assms(3,4) prems show "u' =
        umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇(φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set β⦇ArrVal⦈⦇u'⦈⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )
      fix f' assume prems': 
        "f' : r ↦𝔄 r'"
        "u' = umap_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈) r'⦇ArrVal⦈⦇f'⦈"
      from prems'(2,1) assms(3,4) have u'_def: 
        "u' = 𝔉⦇ArrMap⦈⦇f'⦈ ∘A𝔅 φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      from prems' show "f' = (φ⦇NTMap⦈⦇r'⦈)¯Ccat_Set β⦇ArrVal⦈⦇u'⦈"
        unfolding u'_def φr'_ArrVal_app[OF prems'(1)]
        by
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and  "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "φ :
      HomO.Cβ𝔄(-,r) ↦CF.iso HomO.Cβ𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦Cβ cat_Set β"
  shows "universal_arrow_fo 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔉: is_functor β 𝔄 𝔅 𝔉
    by (rule cf_is_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+
  show ?thesis 
    by 
      (
        rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit
          [
            OF is_functor_op,
            OF assms(1,2),
            unfolded cat_op_simps,
            OF assms(3,4),
            unfolded 
              β𝔉.HomDom.cat_op_cat_cf_Hom_snd[OF assms(3)] 
              β𝔉.HomCod.cat_op_cat_cf_Hom_snd[OF assms(4)]
              ntcf_ua_fo_def[symmetric],
            OF assms(5)
          ]
      )
qed

text‹\newpage›

end

Theory CZH_UCAT_Limit

(* Copyright 2021 (C) Mihails Milehins *)

section‹Limits›
theory CZH_UCAT_Limit
  imports 
    CZH_UCAT_Universal
    CZH_Elementary_Categories.CZH_ECAT_Discrete 
    CZH_Elementary_Categories.CZH_ECAT_SS
    CZH_Elementary_Categories.CZH_ECAT_Parallel
begin



subsection‹Background›

named_theorems cat_lim_cs_simps
named_theorems cat_lim_cs_intros



subsection‹Cone and cocone›


text‹
In the context of this work, the concept of a cone corresponds to that of a cone
to the base of a functor from a vertex, as defined in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
of a cone from the base of a functor to a vertex, as defined in Chapter III-3
in \cite{mac_lane_categories_2010}.

In this body of work, only limits and colimits of functors with tiny maps 
are considered. The definitions of a cone and a cocone also reflect this.
However, this restriction may be removed in the future.
›

(*TODO: remove the size limitation; see TODO in the next subsection*)
locale is_cat_cone = is_tm_ntcf α 𝔍 ℭ ‹cf_const 𝔍 ℭ c› 𝔉 𝔑 for α c 𝔍 ℭ 𝔉 𝔑 +
  assumes cat_cone_obj[cat_lim_cs_intros]: "c ∈∘ ℭ⦇Obj⦈"

syntax "_is_cat_cone" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.cone _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "𝔑 : c <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_cone α c 𝔍 ℭ 𝔉 𝔑"

locale is_cat_cocone = is_tm_ntcf α 𝔍 ℭ 𝔉 ‹cf_const 𝔍 ℭ c› 𝔑 for α c 𝔍 ℭ 𝔉 𝔑 +
  assumes cat_cocone_obj[cat_lim_cs_intros]: "c ∈∘ ℭ⦇Obj⦈"

syntax "_is_cat_cocone" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ >CF.cocone _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 >CF.cocone c : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_cocone α c 𝔍 ℭ 𝔉 𝔑"


text‹Rules.›

lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "c' = c" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "𝔑 : c' <CF.cone 𝔉' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_cone_axioms)

mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
  |intro is_cat_coneI|
  |dest is_cat_coneD[dest!]|
  |elim is_cat_coneE[elim!]|

lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
  assumes "c' = cf_const 𝔍 ℭ c"
  shows "𝔑 : c' ↦CF.tm 𝔉 : 𝔍 ↦↦C.tmα ℭ"
  unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)

lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'

lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "c' = c" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "𝔑 : 𝔉' >CF.cocone c' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_cocone_axioms)

mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
  |intro is_cat_coconeI|
  |dest is_cat_coconeD[dest!]|
  |elim is_cat_coconeE[elim!]|

lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
  assumes "c' = cf_const 𝔍 ℭ c"
  shows "𝔑 : 𝔉 ↦CF.tm c' : 𝔍 ↦↦C.tmα ℭ"
  unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)

lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'


text‹Duality.›

lemma (in is_cat_cone) is_cat_cocone_op:
  "op_ntcf 𝔑 : op_cf 𝔉 >CF.cocone c : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  by (intro is_cat_coconeI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)+

lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
  assumes "α' = α" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ" and "𝔉' = op_cf 𝔉"
  shows "op_ntcf 𝔑 : 𝔉' >CF.cocone c : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_cocone_op)

lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'

lemma (in is_cat_cocone) is_cat_cone_op:
  "op_ntcf 𝔑 : c <CF.cone op_cf 𝔉 : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  by (intro is_cat_coneI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)

lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
  assumes "α' = α" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ" and "𝔉' = op_cf 𝔉"
  shows "op_ntcf 𝔑 : c <CF.cone 𝔉' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_cone_op)

lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'


text‹Elementary properties.›

lemma (in is_cat_cone) cat_cone_LArr_app_is_arr: 
  assumes "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑⦇NTMap⦈⦇j⦈ : c ↦ℭ 𝔉⦇ObjMap⦈⦇j⦈"
proof-
  from assms have [simp]: "cf_const 𝔍 ℭ c⦇ObjMap⦈⦇j⦈ = c"
    by (cs_concl cs_simp: cat_cs_simps)
  from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
qed

lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]: 
  assumes "j ∈∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMap⦈⦇j⦈"
  shows "𝔑⦇NTMap⦈⦇j⦈ : c ↦ℭ 𝔉j"
  using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)

lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'

lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr: 
  assumes "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑⦇NTMap⦈⦇j⦈ : 𝔉⦇ObjMap⦈⦇j⦈ ↦ℭ c"
proof-
  from assms have [simp]: "cf_const 𝔍 ℭ c⦇ObjMap⦈⦇j⦈ = c"
    by (cs_concl cs_simp: cat_cs_simps)
  from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
qed

lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]: 
  assumes "j ∈∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMap⦈⦇j⦈"
  shows "𝔑⦇NTMap⦈⦇j⦈ : 𝔉j ↦ℭ c"
  using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)

lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'

lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
  assumes "f : a ↦𝔍 b"
  shows "𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ 𝔑⦇NTMap⦈⦇a⦈ = 𝔑⦇NTMap⦈⦇b⦈"
  using ntcf_Comp_commute[symmetric, OF assms] assms 
  by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute

lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
  assumes "f : a ↦𝔍 b"
  shows "𝔑⦇NTMap⦈⦇b⦈ ∘Aℭ 𝔉⦇ArrMap⦈⦇f⦈ = 𝔑⦇NTMap⦈⦇a⦈"
  using ntcf_Comp_commute[OF assms] assms 
  by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute


text‹Utilities/helper lemmas.›

lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ"
    and "f' : c' ↦ℭ c" 
    and "𝔑' = 𝔑 ∙NTCF ntcf_const 𝔍 ℭ f'" 
    and "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aℭ f'"
proof-
  from assms(3) have "𝔑'⦇NTMap⦈⦇j⦈ = (𝔑 ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
    by simp
  from this assms(1,2,4) show "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aℭ f'"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ"
    and "f' : c' ↦ℭ c" 
    and "⋀j. j ∈∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aℭ f'" 
  shows "𝔑' = 𝔑 ∙NTCF ntcf_const 𝔍 ℭ f'"
proof-
  interpret 𝔑': is_cat_cone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
  show ?thesis
  proof(rule ntcf_eqI[OF 𝔑'.is_ntcf_axioms])
    from assms(2) show 
      "𝔑 ∙NTCF ntcf_const 𝔍 ℭ f' : cf_const 𝔍 ℭ c' ↦CF 𝔉 : 𝔍 ↦↦Cα ℭ"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "𝔑'⦇NTMap⦈ = (𝔑 ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈"
    proof(rule vsv_eqI, unfold cat_cs_simps)
      show "vsv ((𝔑 ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros)
      from assms show "𝔍⦇Obj⦈ = 𝒟∘ ((𝔑 ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      fix j assume prems': "j ∈∘ 𝔍⦇Obj⦈"
      with assms(1,2) show "𝔑'⦇NTMap⦈⦇j⦈ = (𝔑 ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
        by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
    qed auto
  qed simp_all
qed

lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ"
  shows "f' : c' ↦ℭ c ∧ 𝔑' = 𝔑 ∙NTCF ntcf_const 𝔍 ℭ f' ⟷
    f' : c' ↦ℭ c ∧ (∀j∈∘𝔍⦇Obj⦈. 𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aℭ f')"
  using 
    helper_cat_cone_ntcf_vcomp_Comp[OF assms]
    helper_cat_cone_Comp_ntcf_vcomp[OF assms]
  by (intro iffI; elim conjE; intro conjI) metis+

lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦Cα ℭ"
    and "f' : c ↦ℭ c'" 
    and "𝔑' = ntcf_const 𝔍 ℭ f' ∙NTCF 𝔑" 
    and "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ 𝔑⦇NTMap⦈⦇j⦈"
proof-
  interpret 𝔑': is_cat_cocone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
  from assms(3) have "op_ntcf 𝔑' = op_ntcf (ntcf_const 𝔍 ℭ f' ∙NTCF 𝔑)" by simp
  from this assms(2) have op_𝔑':
    "op_ntcf 𝔑' = op_ntcf 𝔑 ∙NTCF ntcf_const (op_cat 𝔍) (op_cat ℭ) f'"
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
  have "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aop_cat ℭ f'"
    by 
      (
        rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
          OF is_cat_cone_op 𝔑'.is_cat_cone_op, 
          unfolded cat_op_simps, 
          OF assms(2) op_𝔑' assms(4)
          ]
      )
  from this assms(2,4) show "𝔑'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ 𝔑⦇NTMap⦈⦇j⦈"
    by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦Cα ℭ"
    and "f' : c ↦ℭ c'" 
    and "⋀j. j ∈∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ 𝔑⦇NTMap⦈⦇j⦈" 
  shows "𝔑' = ntcf_const 𝔍 ℭ f' ∙NTCF 𝔑"
proof-
  interpret 𝔑': is_cat_cocone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
  from assms(2) have 𝔑'j: "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘Aop_cat ℭ f'"
    if "j ∈∘ 𝔍⦇Obj⦈" for j
    using that
    unfolding assms(3)[OF that] 
    by (cs_concl cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros)
  have op_𝔑': 
    "op_ntcf 𝔑' = op_ntcf 𝔑 ∙NTCF ntcf_const (op_cat 𝔍) (op_cat ℭ) f'"
    by 
      (
        rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
          OF is_cat_cone_op 𝔑'.is_cat_cone_op,
          unfolded cat_op_simps, 
          OF assms(2) 𝔑'j, 
          simplified
          ]
      )
  from assms(2) show "𝔑' = (ntcf_const 𝔍 ℭ f' ∙NTCF 𝔑)"
    by 
      (
        cs_concl 
          cs_simp: 
            cat_op_simps op_𝔑' eq_op_ntcf_iff[symmetric, OF 𝔑'.is_ntcf_axioms]
          cs_intro: cat_cs_intros
      )
qed

lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦Cα ℭ"
  shows "f' : c ↦ℭ c' ∧ 𝔑' = ntcf_const 𝔍 ℭ f' ∙NTCF 𝔑 ⟷
    f' : c ↦ℭ c' ∧ (∀j∈∘𝔍⦇Obj⦈. 𝔑'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ 𝔑⦇NTMap⦈⦇j⦈)"
  using 
    helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
    helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
  by (intro iffI; elim conjE; intro conjI) metis+



subsection‹Limit and colimit›


subsubsection‹Definition and elementary properties›


text‹
The concept of a limit is introduced in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
Chapter III-3 in \cite{mac_lane_categories_2010}.
›

(*TODO: remove the size limitation*)
locale is_cat_limit = is_cat_cone α r 𝔍 ℭ 𝔉 u for α 𝔍 ℭ 𝔉 r u +
  assumes cat_lim_ua_fo: 
    "universal_arrow_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u)"

syntax "_is_cat_limit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.lim _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_limit α 𝔍 ℭ 𝔉 r u"

locale is_cat_colimit = is_cat_cocone α r 𝔍 ℭ 𝔉 u for α 𝔍 ℭ 𝔉 r u +
  assumes cat_colim_ua_fo: "universal_arrow_fo 
    (ΔC α (op_cat 𝔍) (op_cat ℭ)) (cf_map 𝔉) r (ntcf_arrow (op_ntcf u))"

syntax "_is_cat_colimit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ >CF.colim _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_colimit α 𝔍 ℭ 𝔉 r u"


text‹Rules.›

lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "u : r' <CF.lim 𝔉' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_limit_axioms)

mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
  |intro is_cat_limitI|
  |dest is_cat_limitD[dest]|
  |elim is_cat_limitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_limitD(1)

lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "u : 𝔉' >CF.colim r' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_colimit_axioms)

mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
  |intro is_cat_colimitI|
  |dest is_cat_colimitD[dest]|
  |elim is_cat_colimitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)


text‹Duality›

lemma (in is_cat_limit) is_cat_colimit_op:
  "op_ntcf u : op_cf 𝔉 >CF.colim r : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  using cat_lim_ua_fo
  by (intro is_cat_colimitI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
  shows "op_ntcf u : 𝔉' >CF.colim r : 𝔍' ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_colimit_op)

lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'

lemma (in is_cat_colimit) is_cat_limit_op:
  "op_ntcf u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  using cat_colim_ua_fo
  by (intro is_cat_limitI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
  shows "op_ntcf u : r <CF.lim 𝔉' : 𝔍' ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_limit_op)

lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'


text‹Elementary properties of limits and colimits.›

sublocale is_cat_limit ⊆ Δ: is_functor α ℭ ‹cat_Funct α 𝔍 ℭ› ‹ΔC α 𝔍 ℭ›
  by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)

sublocale is_cat_colimit ⊆ Δ: is_functor 
  α ‹op_cat ℭ› ‹cat_Funct α (op_cat 𝔍) (op_cat ℭ)› ‹ΔC α (op_cat 𝔍) (op_cat ℭ)›
  by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros cat_op_intros)


subsubsection‹Universal property›

lemma is_cat_limitI':
  assumes "u : r <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ" 
    and "⋀u' r'. ⟦ u' : r' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ ⟧ ⟹ 
      ∃!f'. f' : r' ↦ℭ r ∧ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
  shows "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
proof(intro is_cat_limitI is_functor.universal_arrow_foI)
  interpret u: is_cat_cone α r 𝔍 ℭ 𝔉 u by (rule assms(1))
  show "r ∈∘ ℭ⦇Obj⦈" by (cs_concl cs_intro: cat_lim_cs_intros)
  show "ΔC α 𝔍 ℭ : ℭ ↦↦Cα cat_Funct α 𝔍 ℭ"
    by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
  show "ntcf_arrow u : ΔC α 𝔍 ℭ⦇ObjMap⦈⦇r⦈ ↦cat_Funct α 𝔍 ℭ cf_map 𝔉"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_lim_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  fix r' u' assume prems: 
    "r' ∈∘ ℭ⦇Obj⦈" "u' : ΔC α 𝔍 ℭ⦇ObjMap⦈⦇r'⦈ ↦cat_Funct α 𝔍 ℭ cf_map 𝔉"
  note u' = cat_Funct_is_arrD[OF prems(2)]
  from u'(1) prems(1) have u'_is_tm_ntcf:
    "ntcf_of_ntcf_arrow 𝔍 ℭ u' : cf_const 𝔍 ℭ r' ↦CF.tm 𝔉 : 𝔍 ↦↦C.tmα ℭ"
    by 
      (
        cs_prems 
          cs_simp: cat_cs_simps cat_small_cs_simps cat_FUNCT_cs_simps 
          cs_intro: cat_cs_intros
      )
  from this prems(1) have u'_is_cat_cone: 
    "ntcf_of_ntcf_arrow 𝔍 ℭ u' : r' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ"
    by (intro is_cat_coneI)
  interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 ‹ntcf_of_ntcf_arrow 𝔍 ℭ u'›
    by (rule u'_is_cat_cone)
  from assms(2)[OF u'_is_cat_cone] obtain f' where f': "f' : r' ↦ℭ r"
    and u'_def: "ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
    and unique: "⋀f''.
      ⟦
        f'' : r' ↦ℭ r; 
        ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙NTCF ntcf_const 𝔍 ℭ f''
      ⟧ ⟹ f'' = f'"
    by (meson prems(1))
  from u'_def have u'_NTMap_app:
    "ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇j⦈ = (u ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
    if "j ∈∘ 𝔍⦇Obj⦈" for j 
    by simp
  have u'_NTMap_app: "u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘Aℭ f'"
    if "j ∈∘ 𝔍⦇Obj⦈" for j 
    using u'_NTMap_app[OF that] that f'
    by (cs_prems cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  show "∃!f'.
    f' : r' ↦ℭ r ∧
    u' = umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : r' ↦ℭ r" by (rule f')
    have u'_def'[symmetric, cat_cs_simps]: 
      "ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
    proof(rule ntcf_eqI)
      from u'_is_tm_ntcf show 
        "ntcf_of_ntcf_arrow 𝔍 ℭ u' : cf_const 𝔍 ℭ r' ↦CF 𝔉 : 𝔍 ↦↦Cα ℭ"
        by (cs_concl cs_intro: cat_small_cs_intros)
      from f' show 
        "u ∙NTCF ntcf_const 𝔍 ℭ f' : cf_const 𝔍 ℭ r' ↦CF 𝔉 : 𝔍 ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show 
        "ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈ = (u ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈"
      proof(rule vsv_eqI)
        from f' show "𝒟∘ (ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈) = 
          𝒟∘ ((u ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)    
        show "ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇a⦈ = 
          (u ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇a⦈"
          if "a ∈∘ 𝒟∘ (ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈)" for a
        proof-
          from that have "a ∈∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)    
          with f' show 
            "ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇a⦈ =
              (u ∙NTCF ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇a⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps u'_NTMap_app 
                  cs_intro: cat_cs_intros
              )
        qed
      qed (auto intro: cat_cs_intros)
    qed simp_all
    from f' u'(1) show 
      "u' = umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
      by (subst u'(2))
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    fix f'' assume prems': 
      "f'' : r' ↦ℭ r"
      "u' = umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈"  
    from prems'(2,1) u'(1) have 
      "ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙NTCF ntcf_const 𝔍 ℭ f''"
      by (subst (asm) u'(2))
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from unique[OF prems'(1) this] show "f'' = f'" .
  qed
qed (intro assms)+

lemma (in is_cat_limit) cat_lim_unique_cone:
  assumes "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ" 
  shows "∃!f'. f' : r' ↦ℭ r ∧ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
proof-
  interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 u' by (rule assms(1))
  have "ntcf_arrow u' : ΔC α 𝔍 ℭ⦇ObjMap⦈⦇r'⦈ ↦cat_Funct α 𝔍 ℭ cf_map 𝔉"
    by 
      (
        cs_concl 
          cs_intro: cat_lim_cs_intros cat_FUNCT_cs_intros cs_simp: cat_cs_simps
      )
  from Δ.universal_arrow_foD(3)[OF cat_lim_ua_fo u'.cat_cone_obj this] obtain f'
    where f': "f' : r' ↦ℭ r" 
      and u': "ntcf_arrow u' =
      umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
      and unique:
        "⟦
          f'' : r' ↦ℭ r;
          ntcf_arrow u' =
            umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈
         ⟧ ⟹ f'' = f'"
    for f''
    by metis
  show "∃!f'. f' : r' ↦ℭ r ∧ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : r' ↦ℭ r" by (rule f')
    with u' show "u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    fix f'' assume prems: "f'' : r' ↦ℭ r"  "u' = u ∙NTCF ntcf_const 𝔍 ℭ f''"
    from prems(1) have "ntcf_arrow u' =
      umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps prems(2)[symmetric] 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    from prems(1) this show "f'' = f'" by (intro unique)
  qed
qed  

lemma (in is_cat_limit) cat_lim_unique_cone':
  assumes "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ"
  shows 
    "∃!f'. f' : r' ↦ℭ r ∧ (∀j∈∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘Aℭ f')"
  by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
    (intro cat_lim_unique_cone assms)

lemma (in is_cat_limit) cat_lim_unique:
  assumes "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  shows "∃!f'. f' : r' ↦ℭ r ∧ u' = u ∙NTCF ntcf_const 𝔍 ℭ f'"
  by (intro cat_lim_unique_cone[OF is_cat_limitD(1)[OF assms]])

lemma (in is_cat_limit) cat_lim_unique':
  assumes "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  shows 
    "∃!f'. f' : r' ↦ℭ r ∧ (∀j∈∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘Aℭ f')"
  by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])

lemma (in is_cat_colimit) cat_colim_unique_cocone:
  assumes "u' : 𝔉 >CF.cocone r' : 𝔍 ↦↦Cα ℭ"
  shows "∃!f'. f' : r ↦ℭ r' ∧ u' = ntcf_const 𝔍 ℭ f' ∙NTCF u"
proof-
  interpret u': is_cat_cocone α r' 𝔍 ℭ 𝔉 u' by (rule assms(1))
  from u'.cat_cocone_obj have op_r': "r' ∈∘ op_cat ℭ⦇Obj⦈"
    unfolding cat_op_simps by simp
  from 
    is_cat_limit.cat_lim_unique_cone[
      OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
      ]
  obtain f' where f': "f' : r' ↦op_cat ℭ r"
    and [cat_cs_simps]: 
      "op_ntcf u' = op_ntcf u ∙NTCF op_ntcf (ntcf_const 𝔍 ℭ f')"
    and unique: 
      "⟦
        f'' : r' ↦op_cat ℭ r;
        op_ntcf u' = op_ntcf u ∙NTCF op_ntcf (ntcf_const 𝔍 ℭ f'')
       ⟧ ⟹ f'' = f'" 
    for f''
    by metis
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    from f' show f': "f' : r ↦ℭ r'" unfolding cat_op_simps by simp
    show "u' = ntcf_const 𝔍 ℭ f' ∙NTCF u"
      by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
        (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
    fix f'' assume prems: "f'' : r ↦ℭ r'" "u' = ntcf_const 𝔍 ℭ f'' ∙NTCF u"
    from prems(1) have "f'' : r' ↦op_cat ℭ r" unfolding cat_op_simps by simp
    moreover from prems(1) have 
      "op_ntcf u' = op_ntcf u ∙NTCF op_ntcf (ntcf_const 𝔍 ℭ f'')"
      unfolding prems(2)
      by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
    ultimately show "f'' = f'" by (rule unique)
  qed
qed

lemma (in is_cat_colimit) cat_colim_unique_cocone':
  assumes "u' : 𝔉 >CF.cocone r' : 𝔍 ↦↦Cα ℭ"
  shows 
    "∃!f'. f' : r ↦ℭ r' ∧ (∀j∈∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ u⦇NTMap⦈⦇j⦈)"
  by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
    (intro cat_colim_unique_cocone assms)

lemma (in is_cat_colimit) cat_colim_unique:
  assumes "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦Cα ℭ"
  shows "∃!f'. f' : r ↦ℭ r' ∧ u' = ntcf_const 𝔍 ℭ f' ∙NTCF u"
  by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])

lemma (in is_cat_colimit) cat_colim_unique':
  assumes "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦Cα ℭ"
  shows
    "∃!f'. f' : r ↦ℭ r' ∧ (∀j∈∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ u⦇NTMap⦈⦇j⦈)"
proof-
  interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(1))
  show ?thesis
    by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
      (intro cat_colim_unique assms)
qed

lemma cat_lim_ex_is_arr_isomorphism:
  assumes "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ" 
    and "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  obtains f where "f : r' ↦isoℭ r" and "u' = u ∙NTCF ntcf_const 𝔍 ℭ f"
proof-
  interpret u: is_cat_limit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_limit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
  obtain f where f: "f : r' ↦isoℭ r"
    and u': "ntcf_arrow u' =
    umap_fo (ΔC α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f⦈"
    by 
      (
        elim u.Δ.cf_universal_arrow_fo_ex_is_arr_isomorphism[
          OF u.cat_lim_ua_fo u'.cat_lim_ua_fo
          ]
      )
  from f have "f : r' ↦ℭ r" by auto
  from u' this have "u' = u ∙NTCF ntcf_const 𝔍 ℭ f"
    by
      (
        cs_prems
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_small_cs_simps
          cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
      )
  with f that show ?thesis by simp
qed

lemma cat_lim_ex_is_arr_isomorphism':
  assumes "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ" 
    and "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  obtains f where "f : r' ↦isoℭ r" 
    and "⋀j. j ∈∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘Aℭ f"
proof-
  interpret u: is_cat_limit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_limit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
  from assms obtain f 
    where iso_f: "f : r' ↦isoℭ r" and u'_def: "u' = u ∙NTCF ntcf_const 𝔍 ℭ f"
    by (rule cat_lim_ex_is_arr_isomorphism)
  then have f: "f : r' ↦ℭ r" by auto
  then have "u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘Aℭ f" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by 
      (
        intro u.helper_cat_cone_ntcf_vcomp_Comp[
          OF u'.is_cat_cone_axioms f u'_def that
          ]
      )
  with iso_f that show ?thesis by simp
qed

lemma cat_colim_ex_is_arr_isomorphism:
  assumes "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ" 
    and "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦Cα ℭ"
  obtains f where "f : r ↦isoℭ r'" and "u' = ntcf_const 𝔍 ℭ f ∙NTCF u"
proof-
  interpret u: is_cat_colimit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
  obtain f where f: "f : r' ↦isoop_cat ℭ r"
    and [cat_cs_simps]: 
      "op_ntcf u' = op_ntcf u ∙NTCF ntcf_const (op_cat 𝔍) (op_cat ℭ) f"
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF u.is_cat_limit_op u'.is_cat_limit_op
          ]
      )
  from f have iso_f: "f : r ↦isoℭ r'" unfolding cat_op_simps by simp
  then have f: "f : r ↦ℭ r'" by auto
  have "u' = ntcf_const 𝔍 ℭ f ∙NTCF u"
    by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
      (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
  from iso_f this that show ?thesis by simp
qed

lemma cat_colim_ex_is_arr_isomorphism':
  assumes "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ" 
    and "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦Cα ℭ"
  obtains f where "f : r ↦isoℭ r'"
    and "⋀j. j ∈∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMap⦈⦇j⦈ = f ∘Aℭ u⦇NTMap⦈⦇j⦈"
proof-
  interpret u: is_cat_colimit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
  from assms obtain f 
    where iso_f: "f : r ↦isoℭ r'" and u'_def: "u' = ntcf_const 𝔍 ℭ f ∙NTCF u"
    by (rule cat_colim_ex_is_arr_isomorphism)
  then have f: "f : r ↦ℭ r'" by auto
  then have "u'⦇NTMap⦈⦇j⦈ = f ∘Aℭ u⦇NTMap⦈⦇j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by 
      (
        intro u.helper_cat_cocone_ntcf_vcomp_Comp[
          OF u'.is_cat_cocone_axioms f u'_def that
          ]
      )
  with iso_f that show ?thesis by simp
qed



subsection‹Finite limit and finite colimit›

locale is_cat_finite_limit = is_cat_limit α 𝔍 ℭ 𝔉 r u + finite_category α 𝔍
  for α 𝔍 ℭ 𝔉 r u

syntax "_is_cat_finite_limit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.lim.fin _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : r <CF.lim.fin 𝔉 : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_finite_limit α 𝔍 ℭ 𝔉 r u"

locale is_cat_finite_colimit = is_cat_colimit α 𝔍 ℭ 𝔉 r u + finite_category α 𝔍
  for α 𝔍 ℭ 𝔉 r u

syntax "_is_cat_finite_colimit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ >CF.colim.fin _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >CF.colim.fin r : 𝔍 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_finite_colimit α 𝔍 ℭ 𝔉 r u"


text‹Rules.›

lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "u : r' <CF.lim.fin 𝔉' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_finite_limit_axioms)

mk_ide rf is_cat_finite_limit_def
  |intro is_cat_finite_limitI|
  |dest is_cat_finite_limitD[dest]|
  |elim is_cat_finite_limitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_limitD

lemma (in is_cat_finite_colimit) 
  is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
  shows "u : 𝔉' >CF.colim.fin r' : 𝔍' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_finite_colimit_axioms)

mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
  |intro is_cat_finite_colimitI|
  |dest is_cat_finite_colimitD[dest]|
  |elim is_cat_finite_colimitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD


text‹Duality›

lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
  "op_ntcf u : op_cf 𝔉 >CF.colim.fin r : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  by 
    (
      cs_concl cs_intro:
        is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
    )

lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
  shows "op_ntcf u : 𝔉' >CF.colim.fin r : 𝔍' ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_finite_colimit_op)

lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'

lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
  "op_ntcf u : r <CF.lim.fin op_cf 𝔉 : op_cat 𝔍 ↦↦Cα op_cat ℭ"
  by 
    (
      cs_concl cs_intro: 
        is_cat_finite_limitI cat_op_intros cat_small_cs_intros
    )

lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
  shows "op_ntcf u : r <CF.lim.fin 𝔉' : 𝔍' ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_finite_limit_op)

lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'



subsection‹Product and coproduct›


subsubsection‹Definition and elementary properties›


text‹
The definition of the product object is a specialization of the 
definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
In the definition presented below, the discrete category that is used in the 
definition presented in \cite{mac_lane_categories_2010} is parameterized by
an index set and the functor from the discrete category is 
parameterized by a function from the index set to the set of 
the objects of the category.
›

locale is_cat_obj_prod = 
  is_cat_limit α ‹:C I› ℭ ‹:→: I A ℭ› P π + cf_discrete α I A ℭ
  for α I A ℭ P π

syntax "_is_cat_obj_prod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.∏ _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <CF.∏ A : I ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_obj_prod α I A ℭ P π"

locale is_cat_obj_coprod = 
  is_cat_colimit α ‹:C I› ℭ ‹:→: I A ℭ› U π + cf_discrete α I A ℭ
  for α I A ℭ U π

syntax "_is_cat_obj_coprod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ >CF.∐ _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : A >CF.∐ U : I ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_obj_coprod α I A ℭ U π"


text‹Rules.›

lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "P' = P" and "A' = A" and "I' = I" and "ℭ' = ℭ" 
  shows "π : P' <CF.∏ A' : I' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_obj_prod_axioms)

mk_ide rf is_cat_obj_prod_def
  |intro is_cat_obj_prodI|
  |dest is_cat_obj_prodD[dest]|
  |elim is_cat_obj_prodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_prodD

lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "U' = U" and "A' = A" and "I' = I" and "ℭ' = ℭ" 
  shows "π : A' >CF.∐ U' : I' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_obj_coprod_axioms)

mk_ide rf is_cat_obj_coprod_def
  |intro is_cat_obj_coprodI|
  |dest is_cat_obj_coprodD[dest]|
  |elim is_cat_obj_coprodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD


text‹Duality.›

lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
  "op_ntcf π : A >CF.∐ P : I ↦↦Cα op_cat ℭ"
  using cf_discrete_vdomain_vsubset_Vset
  by (intro is_cat_obj_coprodI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : A >CF.∐ P : I ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_coprod_op)

lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'

lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
  "op_ntcf π : U <CF.∏ A : I ↦↦Cα op_cat ℭ"
  using cf_discrete_vdomain_vsubset_Vset
  by (intro is_cat_obj_prodI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : U <CF.∏ A : I ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_prod_op)

lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'


subsubsection‹Universal property›

(*cat_obj_prod_unique_cone already proven*)
lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
  assumes "π' : P' <CF.cone :→: I A ℭ : :C I ↦↦Cα ℭ"
  shows "∃!f'. f' : P' ↦ℭ P ∧ (∀j∈∘I. π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘Aℭ f')"
  by 
    (
      rule cat_lim_unique_cone'[
        OF assms, unfolded the_cat_discrete_components(1)
        ]
    )

lemma (in is_cat_obj_prod) cat_obj_prod_unique:
  assumes "π' : P' <CF.∏ A : I ↦↦Cα ℭ"
  shows "∃!f'. f' : P' ↦ℭ P ∧ π' = π ∙NTCF ntcf_const (:C I) ℭ f'"
  by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])

lemma (in is_cat_obj_prod) cat_obj_prod_unique':
  assumes "π' : P' <CF.∏ A : I ↦↦Cα ℭ"
  shows "∃!f'. f' : P' ↦ℭ P ∧ (∀i∈∘I. π'⦇NTMap⦈⦇i⦈ = π⦇NTMap⦈⦇i⦈ ∘Aℭ f')"
proof-
  interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(1))
  show ?thesis
    by 
      (
        rule cat_lim_unique'[
          OF π'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
          ]
      )
qed

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
  assumes "π' : :→: I A ℭ >CF.cocone U' : :C I ↦↦Cα ℭ"
  shows "∃!f'. f' : U ↦ℭ U' ∧ (∀j∈∘I. π'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ π⦇NTMap⦈⦇j⦈)"
  by 
    (
      rule cat_colim_unique_cocone'[
        OF assms, unfolded the_cat_discrete_components(1)
        ]
    )

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
  assumes "π' : A >CF.∐ U' : I ↦↦Cα ℭ"
  shows "∃!f'. f' : U ↦ℭ U' ∧ π' = ntcf_const (:C I) ℭ f' ∙NTCF π"
  by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
  assumes "π' : A >CF.∐ U' : I ↦↦Cα ℭ"
  shows "∃!f'. f' : U ↦ℭ U' ∧ (∀j∈∘I. π'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ π⦇NTMap⦈⦇j⦈)"
  by 
    (
      rule cat_colim_unique'[
        OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
        ]
    )

lemma cat_obj_prod_ex_is_arr_isomorphism:
  assumes "π : P <CF.∏ A : I ↦↦Cα ℭ" and "π' : P' <CF.∏ A : I ↦↦Cα ℭ"
  obtains f where "f : P' ↦isoℭ P" and "π' = π ∙NTCF ntcf_const (:C I) ℭ f"
proof-
  interpret π: is_cat_obj_prod α I A ℭ P π by (rule assms(1))
  interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF π.is_cat_limit_axioms π'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_obj_prod_ex_is_arr_isomorphism':
  assumes "π : P <CF.∏ A : I ↦↦Cα ℭ" and "π' : P' <CF.∏ A : I ↦↦Cα ℭ"
  obtains f where "f : P' ↦isoℭ P" 
    and "⋀j. j ∈∘ I ⟹ π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘Aℭ f"
proof-
  interpret π: is_cat_obj_prod α I A ℭ P π by (rule assms(1))
  interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF π.is_cat_limit_axioms π'.is_cat_limit_axioms,
          unfolded the_cat_discrete_components(1)
          ]
      )
qed

lemma cat_obj_coprod_ex_is_arr_isomorphism:
  assumes "π : A >CF.∐ U : I ↦↦Cα ℭ" and "π' : A >CF.∐ U' : I ↦↦Cα ℭ"
  obtains f where "f : U ↦isoℭ U'" and "π' = ntcf_const (:C I) ℭ f ∙NTCF π"
proof-
  interpret π: is_cat_obj_coprod α I A ℭ U π by (rule assms(1))
  interpret π': is_cat_obj_coprod α I A ℭ U' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF π.is_cat_colimit_axioms π'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_obj_coprod_ex_is_arr_isomorphism':
  assumes "π : A >CF.∐ U : I ↦↦Cα ℭ" and "π' : A >CF.∐ U' : I ↦↦Cα ℭ"
  obtains f where "f : U ↦isoℭ U'" 
    and "⋀j. j ∈∘ I ⟹ π'⦇NTMap⦈⦇j⦈ = f ∘Aℭ π⦇NTMap⦈⦇j⦈"
proof-
  interpret π: is_cat_obj_coprod α I A ℭ U π by (rule assms(1))
  interpret π': is_cat_obj_coprod α I A ℭ U' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF π.is_cat_colimit_axioms π'.is_cat_colimit_axioms,
          unfolded the_cat_discrete_components(1)
          ]
      )
qed



subsection‹Finite product and finite coproduct›

locale is_cat_finite_obj_prod = is_cat_obj_prod α I A ℭ P π 
  for α I A ℭ P π +
  assumes cat_fin_obj_prod_index_in_ω: "I ∈∘ ω" 

syntax "_is_cat_finite_obj_prod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.∏.fin _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <CF.∏.fin A : I ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_finite_obj_prod α I A ℭ P π"

locale is_cat_finite_obj_coprod = is_cat_obj_coprod α I A ℭ U π 
  for α I A ℭ U π +
  assumes cat_fin_obj_coprod_index_in_ω: "I ∈∘ ω" 

syntax "_is_cat_finite_obj_coprod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ >CF.∐.fin _ :/ _ ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : A >CF.∐.fin U : I ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_finite_obj_coprod α I A ℭ U π"

lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
  using cat_fin_obj_prod_index_in_ω by auto

sublocale is_cat_finite_obj_prod ⊆ I: finite_category α ‹:C I›
  by (intro finite_categoryI')
    (
      auto
        simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
        intro!: cat_fin_obj_prod_index_vfinite
    )

lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
  "vfinite I"
  using cat_fin_obj_coprod_index_in_ω by auto

sublocale is_cat_finite_obj_coprod ⊆ I: finite_category α ‹:C I›
  by (intro finite_categoryI')
    (
      auto 
        simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components 
        intro!: cat_fin_obj_coprod_index_vfinite
    )


text‹Rules.›

lemma (in is_cat_finite_obj_prod) 
  is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "P' = P" and "A' = A" and "I' = I" and "ℭ' = ℭ" 
  shows "π : P' <CF.∏.fin A' : I' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_finite_obj_prod_axioms)

mk_ide rf 
  is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
  |intro is_cat_finite_obj_prodI|
  |dest is_cat_finite_obj_prodD[dest]|
  |elim is_cat_finite_obj_prodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD

lemma (in is_cat_finite_obj_coprod) 
  is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "U' = U" and "A' = A" and "I' = I" and "ℭ' = ℭ" 
  shows "π : A' >CF.∐.fin U' : I' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_finite_obj_coprod_axioms)

mk_ide rf 
  is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
  |intro is_cat_finite_obj_coprodI|
  |dest is_cat_finite_obj_coprodD[dest]|
  |elim is_cat_finite_obj_coprodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD


text‹Duality.›

lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
  "op_ntcf π : A >CF.∐.fin P : I ↦↦Cα op_cat ℭ"
  by (intro is_cat_finite_obj_coprodI)
    (
      cs_concl 
        cs_simp: cat_op_simps 
        cs_intro: cat_fin_obj_prod_index_in_ω cat_cs_intros cat_op_intros
    )

lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : A >CF.∐.fin P : I ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_finite_obj_coprod_op)

lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'

lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
  "op_ntcf π : U <CF.∏.fin A : I ↦↦Cα op_cat ℭ"
  by (intro is_cat_finite_obj_prodI)
    (
      cs_concl 
        cs_simp: cat_op_simps 
        cs_intro: cat_fin_obj_coprod_index_in_ω cat_cs_intros cat_op_intros
    )

lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : U <CF.∏.fin A : I ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_finite_obj_prod_op)

lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'



subsection‹Product and coproduct of two objects›


subsubsection‹Definition and elementary properties›

locale is_cat_obj_prod_2 = is_cat_obj_prod α ‹2ℕ› ‹if2 a b› ℭ P π
  for α a b ℭ P π

syntax "_is_cat_obj_prod_2" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.× {_,_} :/ 2C ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <CF.× {a,b} : 2C ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_obj_prod_2 α a b ℭ P π"

locale is_cat_obj_coprod_2 = is_cat_obj_coprod α ‹2ℕ› ‹if2 a b› ℭ P π
  for α a b ℭ P π

syntax "_is_cat_obj_coprod_2" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ {_,_} >CF.⊎ _ :/ 2C ↦↦Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : {a,b} >CF.⊎ U : 2C ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_obj_coprod_2 α a b ℭ U π"

abbreviation proj_fst where "proj_fst π ≡ vpfst (π⦇NTMap⦈)"
abbreviation proj_snd where "proj_snd π ≡ vpsnd (π⦇NTMap⦈)"


text‹Rules.›

lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "P' = P" and "a' = a" and "b' = b" and "ℭ' = ℭ" 
  shows "π : P' <CF.× {a',b'} : 2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_prod_2_axioms)

mk_ide rf is_cat_obj_prod_2_def
  |intro is_cat_obj_prod_2I|
  |dest is_cat_obj_prod_2D[dest]|
  |elim is_cat_obj_prod_2E[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D

lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "P' = P" and "a' = a" and "b' = b" and "ℭ' = ℭ" 
  shows "π : {a',b'} >CF.⊎ P' : 2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_coprod_2_axioms)

mk_ide rf is_cat_obj_coprod_2_def
  |intro is_cat_obj_coprod_2I|
  |dest is_cat_obj_coprod_2D[dest]|
  |elim is_cat_obj_coprod_2E[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D


text‹Duality.›

lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
  "op_ntcf π : {a,b} >CF.⊎ P : 2C ↦↦Cα op_cat ℭ"
  by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])

lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : {a,b} >CF.⊎ P : 2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_coprod_2_op)

lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'

lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
  "op_ntcf π : P <CF.× {a,b} : 2C ↦↦Cα op_cat ℭ"
  by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])

lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf π : P <CF.× {a,b} : 2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_obj_prod_2_op)

lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'


text‹Product/coproduct of two objects is a finite product/coproduct.›

sublocale is_cat_obj_prod_2 ⊆ is_cat_finite_obj_prod α ‹2ℕ› ‹if2 a b› ℭ P π
proof(intro is_cat_finite_obj_prodI)
  show "2ℕ ∈∘ ω" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)

sublocale is_cat_obj_coprod_2 ⊆ is_cat_finite_obj_coprod α ‹2ℕ› ‹if2 a b› ℭ P π
proof(intro is_cat_finite_obj_coprodI)
  show "2ℕ ∈∘ ω" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)


text‹Elementary properties.›

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
  shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈∘ ℭ⦇Obj⦈" 
    and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈∘ ℭ⦇Obj⦈"
proof-
  have 0: "0 ∈∘ 2ℕ" and 1: "1ℕ ∈∘ 2ℕ" by simp_all
  show "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
    by 
      (
        intro 
          cf_discrete_selector_vrange[OF 0, simplified]
          cf_discrete_selector_vrange[OF 1, simplified]
      )+
qed

lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
  shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈∘ ℭ⦇Obj⦈" 
    and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈∘ ℭ⦇Obj⦈"
  by 
    (
      intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
        OF is_cat_obj_prod_2_op, unfolded cat_op_simps
        ]
    )+

lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj


text‹Utilities/help lemmas.›

lemma helper_I2_proj_fst_proj_snd_iff: 
  "(∀j∈∘2ℕ. π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘Aℭ f') ⟷
    (proj_fst π' = proj_fst π ∘Aℭ f' ∧ proj_snd π' = proj_snd π ∘Aℭ f')" 
  unfolding two by auto

lemma helper_I2_proj_fst_proj_snd_iff': 
  "(∀j∈∘2ℕ. π'⦇NTMap⦈⦇j⦈ = f' ∘Aℭ π⦇NTMap⦈⦇j⦈) ⟷
    (proj_fst π' = f' ∘Aℭ proj_fst π ∧ proj_snd π' = f' ∘Aℭ proj_snd π)" 
  unfolding two by auto


subsubsection‹Universal property›

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
  assumes "π' : P' <CF.cone :→: (2ℕ) (if2 a b) ℭ : :C (2ℕ) ↦↦Cα ℭ"
  shows
    "∃!f'. f' : P' ↦ℭ P ∧
      proj_fst π' = proj_fst π ∘Aℭ f' ∧
      proj_snd π' = proj_snd π ∘Aℭ f'"
  by 
    (
      rule cat_obj_prod_unique_cone'[
        OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
        ]
    )

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
  assumes "π' : P' <CF.× {a,b} : 2C ↦↦Cα ℭ"
  shows "∃!f'. f' : P' ↦ℭ P ∧ π' = π ∙NTCF ntcf_const (:C (2ℕ)) ℭ f'"
  by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
  assumes "π' : P' <CF.× {a,b} : 2C ↦↦Cα ℭ"
  shows
    "∃!f'. f' : P' ↦ℭ P ∧
      proj_fst π' = proj_fst π ∘Aℭ f' ∧
      proj_snd π' = proj_snd π ∘Aℭ f'"
  by 
    (
      rule cat_obj_prod_unique'[
        OF is_cat_obj_prod_2D[OF assms], 
        unfolded helper_I2_proj_fst_proj_snd_iff
        ]
    )

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
  assumes "π' : :→: (2ℕ) (if2 a b) ℭ >CF.cocone P' : :C (2ℕ) ↦↦Cα ℭ"
  shows
    "∃!f'. f' : P ↦ℭ P' ∧
      proj_fst π' = f' ∘Aℭ proj_fst π ∧
      proj_snd π' = f' ∘Aℭ proj_snd π"
  by 
    (
      rule cat_obj_coprod_unique_cocone'[
        OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
        ]
    )

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
  assumes "π' : {a,b} >CF.⊎ P' : 2C ↦↦Cα ℭ"
  shows "∃!f'. f' : P ↦ℭ P' ∧ π' = ntcf_const (:C (2ℕ)) ℭ f' ∙NTCF π"
  by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
  assumes "π' : {a,b} >CF.⊎ P' : 2C ↦↦Cα ℭ"
  shows
    "∃!f'. f' : P ↦ℭ P' ∧
      proj_fst π' = f' ∘Aℭ proj_fst π ∧
      proj_snd π' = f' ∘Aℭ proj_snd π"
  by 
    (
      rule cat_obj_coprod_unique'[
        OF is_cat_obj_coprod_2D[OF assms], 
        unfolded helper_I2_proj_fst_proj_snd_iff'
        ]
    )

lemma cat_obj_prod_2_ex_is_arr_isomorphism:
  assumes "π : P <CF.× {a,b} : 2C ↦↦Cα ℭ" 
    and "π' : P' <CF.× {a,b} : 2C ↦↦Cα ℭ"
  obtains f where "f : P' ↦isoℭ P" and "π' = π ∙NTCF ntcf_const (:C (2ℕ)) ℭ f"
proof-
  interpret π: is_cat_obj_prod_2 α a b ℭ P π by (rule assms(1))
  interpret π': is_cat_obj_prod_2 α a b ℭ P' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_obj_prod_ex_is_arr_isomorphism[
          OF π.is_cat_obj_prod_axioms π'.is_cat_obj_prod_axioms
          ]
      )
qed

lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
  assumes "π : {a,b} >CF.⊎ U : 2C ↦↦Cα ℭ" 
    and "π' : {a,b} >CF.⊎ U' : 2C ↦↦Cα ℭ"
  obtains f where "f : U ↦isoℭ U'" and "π' = ntcf_const (:C (2ℕ)) ℭ f ∙NTCF π"
proof-
  interpret π: is_cat_obj_coprod_2 α a b ℭ U π by (rule assms(1))
  interpret π': is_cat_obj_coprod_2 α a b ℭ U' π' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_obj_coprod_ex_is_arr_isomorphism[
          OF π.is_cat_obj_coprod_axioms π'.is_cat_obj_coprod_axioms
          ]
      )
qed



subsection‹Pullbacks and pushouts›


subsubsection‹Definition and elementary properties›


text‹
The definitions and the elementary properties of the pullbacks and the 
pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in 
\cite{mac_lane_categories_2010}. 
›

locale is_cat_pullback =
  is_cat_limit α ‹→∙←C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ› X x + 
  cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ
  for α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x 

syntax "_is_cat_pullback" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.pb _→_→_←_←_ ↦↦Cı _)› [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x"
                        
locale is_cat_pushout =
  is_cat_colimit α ‹←∙→C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ› X x +
  cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ
  for α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x

syntax "_is_cat_pushout" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _←_←_→_→_ >CF.po _ ↦↦Cı _)› [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x"


text‹Rules.›

lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
  assumes "α' = α"
    and "𝔞' = 𝔞"
    and "𝔤' = 𝔤"
    and "𝔬' = 𝔬"
    and "𝔣' = 𝔣"
    and "𝔟' = 𝔟"
    and "ℭ' = ℭ"
    and "X' = X"
  shows "x : X' <CF.pb 𝔞'→𝔤'→𝔬'←𝔣'←𝔟' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_pullback_axioms)

mk_ide rf is_cat_pullback_def
  |intro is_cat_pullbackI|
  |dest is_cat_pullbackD[dest]|
  |elim is_cat_pullbackE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_pullbackD

lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
  assumes "α' = α"
    and "𝔞' = 𝔞"
    and "𝔤' = 𝔤"
    and "𝔬' = 𝔬"
    and "𝔣' = 𝔣"
    and "𝔟' = 𝔟"
    and "ℭ' = ℭ"
    and "X' = X"
  shows "x : 𝔞'←𝔤'←𝔬'→𝔣'→𝔟' >CF.po X' ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_pushout_axioms)

mk_ide rf is_cat_pushout_def
  |intro is_cat_pushoutI|
  |dest is_cat_pushoutD[dest]|
  |elim is_cat_pushoutE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_pushoutD


text‹Duality.›

lemma (in is_cat_pullback) is_cat_pushout_op:
  "op_ntcf x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα op_cat ℭ"
  by (intro is_cat_pushoutI) 
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_pushout_op)

lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'

lemma (in is_cat_pushout) is_cat_pullback_op:
  "op_ntcf x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα op_cat ℭ"
  by (intro is_cat_pullbackI) 
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_pullback_op)

lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'


text‹Elementary properties.›

lemma cat_cone_cospan:
  assumes "x : X <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"
    and "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
  shows "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈"
    and "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
    and "𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
proof-
  interpret x: is_cat_cone α X ‹→∙←C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ› x 
    by (rule assms(1))
  interpret cospan: cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
  have 𝔤SS: "𝔤SS : 𝔞SS ↦→∙←C 𝔬SS" and 𝔣SS: "𝔣SS : 𝔟SS ↦→∙←C 𝔬SS" 
    by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
  from x.ntcf_Comp_commute[OF 𝔤SS] 𝔤SS 𝔣SS show
    "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈"
    by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  moreover from x.ntcf_Comp_commute[OF 𝔣SS] 𝔤SS 𝔣SS show 
    "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
    by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈" by simp
qed

lemma (in is_cat_pullback) cat_pb_cone_cospan:
  shows "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈"
    and "x⦇NTMap⦈⦇𝔬SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
    and "𝔤 ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ = 𝔣 ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
  by (all‹rule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]›)

lemma cat_cocone_span:
  assumes "x : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ >CF.cocone X : ←∙→C ↦↦Cα ℭ"
    and "cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
  shows "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤"
    and "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣"
    and "x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤 = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣"
proof-
  interpret x: is_cat_cocone α X ‹←∙→C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ› x
    by (rule assms(1))
  interpret span: cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
  note op = 
    cat_cone_cospan
      [
        OF 
          x.is_cat_cone_op[unfolded cat_op_simps] 
          span.cf_scospan_op, 
          unfolded cat_op_simps
      ]
  from op(1) show "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤"
    by 
      (
        cs_prems 
          cs_simp: cat_ss_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )
  moreover from op(2) show "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣"
    by 
      (
        cs_prems 
          cs_simp: cat_ss_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )
  ultimately show "x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤 = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣" by auto
qed

lemma (in is_cat_pushout) cat_po_cocone_span:
  shows "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤"
    and "x⦇NTMap⦈⦇𝔬SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣"
    and "x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ 𝔤 = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ 𝔣"
  by (all‹rule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]›)


subsubsection‹Universal property›

lemma is_cat_pullbackI':
  assumes "x : X <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"
    and "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
    and "⋀x' X'.
      x' : X' <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ ⟹
        ∃!f'.
          f' : X' ↦ℭ X ∧
          x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f' ∧
          x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f'"
  shows "x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
proof(intro is_cat_pullbackI is_cat_limitI')

  show "x : X <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ" 
    by (rule assms(1))
  interpret x: is_cat_cone α X ‹→∙←C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ› x 
    by (rule assms(1))
  show "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ" by (rule assms(2))
  interpret cospan: cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))

  fix u' r' assume prems:
    "u' : r' <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"

  interpret u': is_cat_cone α r' ‹→∙←C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ› u' 
    by (rule prems)

  from assms(3)[OF prems] obtain f' 
    where f': "f' : r' ↦ℭ X"
      and u'_𝔞SS: "u'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f'"
      and u'_𝔟SS: "u'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f'"
      and unique_f': "⋀f''.
        ⟦
          f'' : r' ↦ℭ X;
          u'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f'';
          u'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f''
        ⟧ ⟹ f'' = f'"
    by metis

  show "∃!f'. f' : r' ↦ℭ X ∧ u' = x ∙NTCF ntcf_const →∙←C ℭ f'"
  proof(intro ex1I conjI; (elim conjE)?)

    show "u' = x ∙NTCF ntcf_const →∙←C ℭ f'"
    proof(rule ntcf_eqI)
      show "u' : cf_const →∙←C ℭ r' ↦CF ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"
        by (rule u'.is_ntcf_axioms)
      from f' show 
        "x ∙NTCF ntcf_const →∙←C ℭ f' :
          cf_const →∙←C ℭ r' ↦CF ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ :
          →∙←C ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from f' have dom_rhs: 
        "𝒟∘ ((x ∙NTCF ntcf_const →∙←C ℭ f')⦇NTMap⦈) = →∙←C⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "u'⦇NTMap⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
        fix a assume prems': "a ∈∘ →∙←C⦇Obj⦈"
        from this f' x.is_ntcf_axioms show
          "u'⦇NTMap⦈⦇a⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f')⦇NTMap⦈⦇a⦈"
          by (elim the_cat_scospan_ObjE; simp only:)
            (
              cs_concl
                cs_simp:
                  cat_cs_simps cat_ss_cs_simps 
                  u'_𝔟SS u'_𝔞SS 
                  cat_cone_cospan(1)[OF assms(1,2)] 
                  cat_cone_cospan(1)[OF prems assms(2)] 
                cs_intro: cat_cs_intros cat_ss_cs_intros
            )+
      qed (cs_concl cs_intro: cat_cs_intros | auto)+
    qed simp_all

    fix f'' assume prems: 
      "f'' : r' ↦ℭ X" "u' = x ∙NTCF ntcf_const →∙←C ℭ f''"
    have 𝔞SS: "𝔞SS ∈∘ →∙←C⦇Obj⦈" and 𝔟SS: "𝔟SS ∈∘ →∙←C⦇Obj⦈" 
      by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
    have "u'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘Aℭ f''" if "a ∈∘ →∙←C⦇Obj⦈" for a
    proof-
      from prems(2) have 
        "u'⦇NTMap⦈⦇a⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f'')⦇NTMap⦈⦇a⦈"
        by simp
      from this that prems(1) show "u'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘Aℭ f''"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
    from unique_f'[OF prems(1) this[OF 𝔞SS] this[OF 𝔟SS]] show "f'' = f'".

  qed (intro f')

qed

lemma is_cat_pushoutI':
  assumes "x : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ >CF.cocone X : ←∙→C ↦↦Cα ℭ"
    and "cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
    and "⋀x' X'. x' : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ >CF.cocone X' : ←∙→C ↦↦Cα ℭ ⟹
      ∃!f'.
        f' : X ↦ℭ X' ∧
        x'⦇NTMap⦈⦇𝔞SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ ∧
        x'⦇NTMap⦈⦇𝔟SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
  shows "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ"
proof-
  interpret x: is_cat_cocone α X ‹←∙→C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ› x 
    by (rule assms(1))
  interpret span: cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
  have assms_3': 
    "∃!f'.
      f' : X ↦ℭ X' ∧
      x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aop_cat ℭ f' ∧
      x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aop_cat ℭ f'"
    if "x' : X' <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFop_cat ℭ : →∙←C ↦↦Cα op_cat ℭ"
    for x' X'
  proof-
    from that(1) have [cat_op_simps]:
      "f' : X ↦ℭ X' ∧ 
      x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aop_cat ℭ f' ∧
      x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aop_cat ℭ f' ⟷
        f' : X ↦ℭ X' ∧
        x'⦇NTMap⦈⦇𝔞SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ ∧
        x'⦇NTMap⦈⦇𝔟SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈" 
      for f'
      by (intro iffI conjI; (elim conjE)?)
        (
          cs_concl 
            cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_ss_cs_intros
        )+
    interpret x': 
      is_cat_cone α X' ‹→∙←C› ‹op_cat ℭ› ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFop_cat ℭ› x'
      by (rule that)
    show ?thesis
      unfolding cat_op_simps
      by 
        (
          rule assms(3)[
            OF x'.is_cat_cocone_op[unfolded cat_op_simps], 
            unfolded cat_op_simps
            ]
        )
  qed
  interpret op_x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ‹op_cat ℭ› X ‹op_ntcf x› 
    using 
      is_cat_pullbackI'
        [
          OF x.is_cat_cone_op[unfolded cat_op_simps] 
          span.cf_scospan_op, 
          unfolded cat_op_simps, 
          OF assms_3'
        ]
    by simp
  show "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ"
    by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
qed
                   
lemma (in is_cat_pullback) cat_pb_unique_cone:
  assumes "x' : X' <CF.cone ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"
  shows "∃!f'.
    f' : X' ↦ℭ X ∧
    x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f' ∧
    x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f'"
proof-
  interpret x': is_cat_cone α X' ‹→∙←C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ› x' 
    by (rule assms)
  from cat_lim_unique_cone[OF assms] obtain f'
    where f': "f' : X' ↦ℭ X" 
      and x'_def: "x' = x ∙NTCF ntcf_const →∙←C ℭ f'"
      and unique_f': "⋀f''.
        ⟦ f'' : X' ↦ℭ X; x' = x ∙NTCF ntcf_const →∙←C ℭ f'' ⟧ ⟹
        f'' = f'"
    by auto
  have 𝔞SS: "𝔞SS ∈∘ →∙←C⦇Obj⦈" and 𝔟SS: "𝔟SS ∈∘ →∙←C⦇Obj⦈"
    by (cs_concl cs_intro: cat_ss_cs_intros)+
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : X' ↦ℭ X" by (rule f')
    have "x'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘Aℭ f'" if "a ∈∘ →∙←C⦇Obj⦈" for a
    proof-
      from x'_def have 
        "x'⦇NTMap⦈⦇a⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f')⦇NTMap⦈⦇a⦈"
        by simp
      from this that f' show "x'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘Aℭ f'"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
    from this[OF 𝔞SS] this[OF 𝔟SS] show 
      "x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f'"
      "x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f'"
      by auto
    fix f'' assume prems': 
      "f'' : X' ↦ℭ X"
      "x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f''"
      "x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f''"
    have "x' = x ∙NTCF ntcf_const →∙←C ℭ f''"
    proof(rule ntcf_eqI)
      show "x' : cf_const →∙←C ℭ X' ↦CF ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ : →∙←C ↦↦Cα ℭ"
        by (rule x'.is_ntcf_axioms)
      from prems'(1) show
        "x ∙NTCF ntcf_const →∙←C ℭ f'' :
          cf_const →∙←C ℭ X' ↦CF ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩CFℭ :
          →∙←C ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have dom_lhs: "𝒟∘ (x'⦇NTMap⦈) = →∙←C⦇Obj⦈" 
        by (cs_concl cs_simp: cat_cs_simps)
      from prems'(1) have dom_rhs:
        "𝒟∘ ((x ∙NTCF ntcf_const →∙←C ℭ f'')⦇NTMap⦈) = →∙←C⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "x'⦇NTMap⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f'')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems'': "a ∈∘ →∙←C⦇Obj⦈"
        from this prems'(1) show 
          "x'⦇NTMap⦈⦇a⦈ = (x ∙NTCF ntcf_const →∙←C ℭ f'')⦇NTMap⦈⦇a⦈"
          by (elim the_cat_scospan_ObjE; simp only:)
            (
              cs_concl 
                cs_simp: 
                  prems'(2,3)
                  cat_cone_cospan(1,2)[OF assms cf_scospan_axioms] 
                  cat_pb_cone_cospan 
                  cat_ss_cs_simps cat_cs_simps 
                cs_intro: cat_ss_cs_intros cat_cs_intros
            )+
      qed (auto simp: cat_cs_intros)
    qed simp_all
    from unique_f'[OF prems'(1) this] show "f'' = f'".
  qed
qed

lemma (in is_cat_pullback) cat_pb_unique:
  assumes "x' : X' <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
  shows "∃!f'. f' : X' ↦ℭ X ∧ x' = x ∙NTCF ntcf_const →∙←C ℭ f'"
  by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])

lemma (in is_cat_pullback) cat_pb_unique':
  assumes "x' : X' <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
  shows "∃!f'.
    f' : X' ↦ℭ X ∧
    x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f' ∧
    x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f'"
proof-
  interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(1))
  show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
qed

lemma (in is_cat_pushout) cat_po_unique_cocone:
  assumes "x' : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ >CF.cocone X' : ←∙→C ↦↦Cα ℭ"
  shows "∃!f'.
    f' : X ↦ℭ X' ∧
    x'⦇NTMap⦈⦇𝔞SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ ∧
    x'⦇NTMap⦈⦇𝔟SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
proof-
  interpret x': is_cat_cocone α X' ‹←∙→C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩CFℭ› x'
    by (rule assms(1))
  have [cat_op_simps]:
    "f' : X ↦ℭ X' ∧
    x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aop_cat ℭ f' ∧
    x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aop_cat ℭ f' ⟷
      f' : X ↦ℭ X' ∧
      x'⦇NTMap⦈⦇𝔞SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ ∧
      x'⦇NTMap⦈⦇𝔟SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈" 
    for f'
    by (intro iffI conjI; (elim conjE)?)
      (
        cs_concl 
          cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps  
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
  show ?thesis
    by 
      (
        rule is_cat_pullback.cat_pb_unique_cone[
          OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps], 
          unfolded cat_op_simps
          ]
     )
qed

lemma (in is_cat_pushout) cat_po_unique:
  assumes "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X' ↦↦Cα ℭ"
  shows "∃!f'. f' : X ↦ℭ X' ∧ x' = ntcf_const ←∙→C ℭ f' ∙NTCF x"
  by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])

lemma (in is_cat_pushout) cat_po_unique':
  assumes "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X' ↦↦Cα ℭ"
  shows "∃!f'.
    f' : X ↦ℭ X' ∧
    x'⦇NTMap⦈⦇𝔞SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈ ∧
    x'⦇NTMap⦈⦇𝔟SS⦈ = f' ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
proof-
  interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(1))
  show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
qed

lemma cat_pullback_ex_is_arr_isomorphism:
  assumes "x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
    and "x' : X' <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
  obtains f where "f : X' ↦isoℭ X" 
    and "x' = x ∙NTCF ntcf_const →∙←C  ℭ f"
proof-
  interpret x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
  interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_pullback_ex_is_arr_isomorphism':
  assumes "x : X <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
    and "x' : X' <CF.pb 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦Cα ℭ"
  obtains f where "f : X' ↦isoℭ X" 
    and "x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f"
    and "x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f"
proof-
  interpret x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
  interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
  obtain f where f: "f : X' ↦isoℭ X"
    and "j ∈∘ →∙←C⦇Obj⦈ ⟹ x'⦇NTMap⦈⦇j⦈ = x⦇NTMap⦈⦇j⦈ ∘Aℭ f" for j
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
          ]
      )
  then have 
    "x'⦇NTMap⦈⦇𝔞SS⦈ = x⦇NTMap⦈⦇𝔞SS⦈ ∘Aℭ f" 
    "x'⦇NTMap⦈⦇𝔟SS⦈ = x⦇NTMap⦈⦇𝔟SS⦈ ∘Aℭ f"
    by (auto simp: cat_ss_cs_intros)
  with f show ?thesis using that by simp
qed

lemma cat_pushout_ex_is_arr_isomorphism:
  assumes "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ"
    and "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X' ↦↦Cα ℭ"
  obtains f where "f : X ↦isoℭ X'" 
    and "x' = ntcf_const ←∙→C ℭ f ∙NTCF x"
proof-
  interpret x: is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
  interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_pushout_ex_is_arr_isomorphism':
  assumes "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X ↦↦Cα ℭ"
    and "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >CF.po X' ↦↦Cα ℭ"
  obtains f where "f : X ↦isoℭ X'" 
    and "x'⦇NTMap⦈⦇𝔞SS⦈ = f ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈"
    and "x'⦇NTMap⦈⦇𝔟SS⦈ = f ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
proof-
  interpret x: is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
  interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
  obtain f where f: "f : X ↦isoℭ X'"
    and "j ∈∘ ←∙→C⦇Obj⦈ ⟹ x'⦇NTMap⦈⦇j⦈ = f ∘Aℭ x⦇NTMap⦈⦇j⦈" for j
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
          unfolded the_cat_parallel_components(1)
          ]
      )
  then have "x'⦇NTMap⦈⦇𝔞SS⦈ = f ∘Aℭ x⦇NTMap⦈⦇𝔞SS⦈"
    and "x'⦇NTMap⦈⦇𝔟SS⦈ = f ∘Aℭ x⦇NTMap⦈⦇𝔟SS⦈"
    by (auto simp: cat_ss_cs_intros)
  with f show ?thesis using that by simp
qed



subsection‹Equalizers and coequalizers›


subsubsection‹Definition and elementary properties›


text‹
See \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}.
›

locale is_cat_equalizer =
  is_cat_limit α ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL› ℭ ‹↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣› E ε 
  for α 𝔞 𝔟 𝔤 𝔣 ℭ E ε +
  assumes cat_eq_𝔤[cat_lim_cs_intros]: "𝔤 : 𝔞 ↦ℭ 𝔟"
    and cat_eq_𝔣[cat_lim_cs_intros]: "𝔣 : 𝔞 ↦ℭ 𝔟"

syntax "_is_cat_equalizer" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ <CF.eq '(_,_,_,_') :/ ↑↑2C ↦↦Cı _)› [51, 51, 51, 51, 51, 51] 51)
translations "ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε"

locale is_cat_coequalizer =
  is_cat_colimit α ‹↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL› ℭ ‹↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤› E ε 
  for α 𝔞 𝔟 𝔤 𝔣 ℭ E ε +
  assumes cat_coeq_𝔤[cat_lim_cs_intros]: "𝔤 : 𝔟 ↦ℭ 𝔞"
    and cat_coeq_𝔣[cat_lim_cs_intros]: "𝔣 : 𝔟 ↦ℭ 𝔞"

syntax "_is_cat_coequalizer" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ '(_,_,_,_') >CF.coeq _ :/ ↑↑2C ↦↦Cı _)› [51, 51, 51, 51, 51, 51] 51)
translations "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ" ⇌ 
  "CONST is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε"


text‹Rules.›

lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
  assumes "α' = α"
    and "E' = E"
    and "𝔞' = 𝔞"
    and "𝔟' = 𝔟"
    and "𝔤' = 𝔤"
    and "𝔣' = 𝔣"
    and "ℭ' = ℭ"
  shows "ε : E' <CF.eq (𝔞',𝔟',𝔤',𝔣') : ↑↑2C ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_equalizer_axioms)

mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
  |intro is_cat_equalizerI|
  |dest is_cat_equalizerD[dest]|
  |elim is_cat_equalizerE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)

lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
  assumes "α' = α"
    and "E' = E"
    and "𝔞' = 𝔞"
    and "𝔟' = 𝔟"
    and "𝔤' = 𝔤"
    and "𝔣' = 𝔣"
    and "ℭ' = ℭ"
  shows "ε : (𝔞',𝔟',𝔤',𝔣') >CF.coeq E' : ↑↑2C ↦↦Cα' ℭ'"
  unfolding assms by (rule is_cat_coequalizer_axioms)

mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
  |intro is_cat_coequalizerI|
  |dest is_cat_coequalizerD[dest]|
  |elim is_cat_coequalizerE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)


text‹Elementary properties.›

sublocale is_cat_equalizer ⊆ cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ 
  by (intro cf_parallelI cat_parallelI)
    (simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)

sublocale is_cat_coequalizer ⊆ cf_parallel α 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 ℭ
  by (intro cf_parallelI cat_parallelI)
    (
      simp_all add: 
        cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros 
        cat_PL_ineq[symmetric]
    )


text‹Duality.›

lemma (in is_cat_equalizer) is_cat_coequalizer_op:
  "op_ntcf ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα op_cat ℭ"
  by (intro is_cat_coequalizerI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros cat_lim_cs_intros)+

lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_coequalizer_op)

lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'

lemma (in is_cat_coequalizer) is_cat_equalizer_op:
  "op_ntcf ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα op_cat ℭ"
  by (intro is_cat_equalizerI)
    (
      cs_concl
        cs_simp: cat_op_simps
        cs_intro: cat_cs_intros cat_op_intros cat_lim_cs_intros
    )+

lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
  assumes "ℭ' = op_cat ℭ"
  shows "op_ntcf ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ'"
  unfolding assms by (rule is_cat_equalizer_op)

lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'


text‹Elementary properties.›

lemma cf_parallel_if_is_cat_cone:
  assumes "ε :
    E <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
    and "𝔤 : 𝔞 ↦ℭ 𝔟"
    and "𝔣 : 𝔞 ↦ℭ 𝔟"
  shows "cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ"
proof-
  let ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣›
  interpret is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
  show ?thesis
    by (intro cf_parallelI cat_parallelI)
      (
        simp_all add: 
          assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
      )
qed

lemma cf_parallel_if_is_cat_cocone:
  assumes "ε' :
    ↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 >CF.cocone E' : ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL ↦↦Cα ℭ"
    and "𝔤 : 𝔟 ↦ℭ 𝔞"
    and "𝔣 : 𝔟 ↦ℭ 𝔞"
  shows "cf_parallel α 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 ℭ"
proof-
  let ?II = ‹↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL› and ?II_II = ‹↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤›
  interpret is_cat_cocone α E' ?II ℭ ?II_II ε' by (rule assms(1))
  show ?thesis
    by (intro cf_parallelI cat_parallelI)
      (
        simp_all add: 
          assms 
          cat_parallel_cs_intros 
          cat_lim_cs_intros 
          cat_cs_intros
          cat_PL_ineq[symmetric]
      )
qed

lemma (in category) cat_cf_parallel_cat_equalizer: 
  assumes "𝔤 : 𝔞 ↦ℭ 𝔟" and "𝔣 : 𝔞 ↦ℭ 𝔟"
  shows "cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ"
  using assms 
  by (intro cf_parallelI cat_parallelI)
    (auto simp: cat_parallel_cs_intros cat_cs_intros)

lemma (in category) cat_cf_parallel_cat_coequalizer: 
  assumes "𝔤 : 𝔟 ↦ℭ 𝔞" and "𝔣 : 𝔟 ↦ℭ 𝔞"
  shows "cf_parallel α 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 ℭ"
  using assms 
  by (intro cf_parallelI cat_parallelI)
    (simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL_ineq[symmetric])

lemma cat_cone_cf_par_eps_NTMap_app:
  assumes "ε :
    E <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
    and "𝔤 : 𝔞 ↦ℭ 𝔟" 
    and "𝔣 : 𝔞 ↦ℭ 𝔟"
  shows 
    "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔤 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈" 
    "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔣 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
proof-
  let ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣›
  interpret ε: is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
  from assms(2,3) have 𝔞: "𝔞 ∈∘ ℭ⦇Obj⦈" and 𝔟: "𝔟 ∈∘ ℭ⦇Obj⦈" by auto
  interpret par: cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ 
    by (intro cf_parallel_if_is_cat_cone, rule assms) (auto intro: assms 𝔞 𝔟)
  have 𝔤PL: "𝔤PL : 𝔞PL ↦↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔟PL" 
    and 𝔣PL: "𝔣PL : 𝔞PL ↦↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔟PL"
    by 
      (
        simp_all add: 
          par.the_cat_parallel_is_arr_𝔞𝔟𝔤 par.the_cat_parallel_is_arr_𝔞𝔟𝔣
      )
  from ε.ntcf_Comp_commute[OF 𝔤PL] show "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔤 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
    by (*slow*)
      (
        cs_prems 
          cs_simp: cat_parallel_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros 
      )
  from ε.ntcf_Comp_commute[OF 𝔣PL] show "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔣 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
    by (*slow*)
      (
        cs_prems 
          cs_simp: cat_parallel_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros 
      )
qed

lemma cat_cocone_cf_par_eps_NTMap_app:
  assumes "ε :
    ↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 >CF.cocone E : ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL ↦↦Cα ℭ"
    and "𝔤 : 𝔟 ↦ℭ 𝔞" 
    and "𝔣 : 𝔟 ↦ℭ 𝔞"
  shows 
    "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔤" 
    "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔣"    
proof-
  let ?II = ‹↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL› and ?II_II = ‹↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤›
  interpret ε: is_cat_cocone α E ?II ℭ ?II_II ε by (rule assms(1))
  from assms(2,3) have 𝔞: "𝔞 ∈∘ ℭ⦇Obj⦈" and 𝔟: "𝔟 ∈∘ ℭ⦇Obj⦈" by auto
  interpret par: cf_parallel α 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 ℭ 
    by (intro cf_parallel_if_is_cat_cocone, rule assms) (auto intro: assms 𝔞 𝔟)
  note ε_NTMap_app = 
    cat_cone_cf_par_eps_NTMap_app[
      OF ε.is_cat_cone_op[unfolded cat_op_simps],
      unfolded cat_op_simps,  
      OF assms(2,3)
      ]
  from ε_NTMap_app show ε_NTMap_app:
    "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔤"
    "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔣"
    by 
      (
        cs_concl
          cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric] 
          cs_intro: cat_cs_intros cat_parallel_cs_intros
      )+
qed

lemma (in is_cat_equalizer) cat_eq_2_eps_NTMap_app:
  "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔤 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈" 
  "ε⦇NTMap⦈⦇𝔟PL⦈ = 𝔣 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
  by 
    (
      intro cat_cone_cf_par_eps_NTMap_app[
        OF is_cat_cone_axioms cat_eq_𝔤 cat_eq_𝔣
        ]
    )+

lemma (in is_cat_coequalizer) cat_coeq_2_eps_NTMap_app:
  "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔤" 
  "ε⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔣"
  by 
    (
      intro cat_cocone_cf_par_eps_NTMap_app[
        OF is_cat_cocone_axioms cat_coeq_𝔤 cat_coeq_𝔣
        ]
    )+

lemma (in is_cat_equalizer) cat_eq_Comp_eq: 
  "𝔤 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈ = 𝔣 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
  "𝔣 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈ = 𝔤 ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
  unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all

lemma (in is_cat_coequalizer) cat_coeq_Comp_eq: 
  "ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔤 = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔣"
  "ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔣 = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ 𝔤"
  unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all


subsubsection‹Universal property›

lemma is_cat_equalizerI':
  assumes "ε :
    E <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
    and "𝔤 : 𝔞 ↦ℭ 𝔟"
    and "𝔣 : 𝔞 ↦ℭ 𝔟"
    and "⋀ε' E'. ε' :
      E' <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : 
      ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ ⟹
      ∃!f'. f' : E' ↦ℭ E ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f'"
  shows "ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
proof-
  let ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣›
  interpret ε: is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
  interpret ℭ: cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ
    by (rule ε.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms(2,3)])
  show ?thesis
  proof(intro is_cat_equalizerI is_cat_limitI' assms(1-3))
    fix u' r' assume prems: "u' : r' <CF.cone ?II_II : ?II ↦↦Cα ℭ"
    interpret u': is_cat_cone α r' ?II ℭ ?II_II u' by (rule prems)
    from assms(4)[OF prems] obtain f'
      where f': "f' : r' ↦ℭ E"
        and u'_NTMap_app_𝔞: "u'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f'"
        and unique_f': 
          "⋀f''.
            ⟦
              f'' : r' ↦ℭ E; 
              u'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f''
            ⟧ ⟹ f'' = f'"
      by metis
    show "∃!f'. f' : r' ↦ℭ E ∧ u' = ε ∙NTCF ntcf_const ?II ℭ f'"
    proof(intro ex1I conjI; (elim conjE)?)
      show "u' = ε ∙NTCF ntcf_const ?II ℭ f'"
      proof(rule ntcf_eqI)
        show "u' : cf_const ?II ℭ r' ↦CF ?II_II : ?II ↦↦Cα ℭ"
          by (rule u'.is_ntcf_axioms)
        from f' show "ε ∙NTCF ntcf_const ?II ℭ f' :
          cf_const ?II ℭ r' ↦CF ?II_II : ?II ↦↦Cα ℭ"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_ss_cs_simps 
                cs_intro: cat_cs_intros cat_ss_cs_intros
            )
        have dom_lhs: "𝒟∘ (u'⦇NTMap⦈) = ?II⦇Obj⦈"
          unfolding cat_cs_simps by simp
        from f' have dom_rhs:
          "𝒟∘ ((ε ∙NTCF ntcf_const ?II ℭ f')⦇NTMap⦈) = ?II⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ = (ε ∙NTCF ntcf_const ?II ℭ f')⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems': "a ∈∘ ?II⦇Obj⦈"
          note [cat_parallel_cs_simps] = 
            cat_cone_cf_par_eps_NTMap_app[OF u'.is_cat_cone_axioms assms(2-3)]
            cat_cone_cf_par_eps_NTMap_app[OF assms(1-3)]
            u'_NTMap_app_𝔞
          from prems' f' assms(2,3) show 
            "u'⦇NTMap⦈⦇a⦈ = (ε ∙NTCF ntcf_const ?II ℭ f')⦇NTMap⦈⦇a⦈"
            by (elim the_cat_parallel_ObjE; simp only:)
              (
                cs_concl 
                  cs_simp: cat_parallel_cs_simps cat_cs_simps
                  cs_intro: cat_cs_intros cat_parallel_cs_intros
              )
        qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
      qed simp_all
      fix f'' assume prems'': 
        "f'' : r' ↦ℭ E" "u' = ε ∙NTCF ntcf_const ?II ℭ f''"
      from prems''(2) have u'_NTMap_a:
        "u'⦇NTMap⦈⦇a⦈ = (ε ∙NTCF ntcf_const ?II ℭ f'')⦇NTMap⦈⦇a⦈"
        for a 
        by simp
      have "u'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f''"  
        using u'_NTMap_a[of 𝔞PL] prems''(1) 
        by 
          (
            cs_prems 
              cs_simp: cat_parallel_cs_simps cat_cs_simps 
              cs_intro: cat_parallel_cs_intros cat_cs_intros
          )
      from unique_f'[OF prems''(1) this] show "f'' = f'".
    qed (rule f')
  qed
qed

lemma is_cat_coequalizerI':
  assumes "ε :
    ↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 >CF.cocone E : 
    ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL ↦↦Cα ℭ"
    and "𝔤 : 𝔟 ↦ℭ 𝔞"
    and "𝔣 : 𝔟 ↦ℭ 𝔞"
    and "⋀ε' E'. ε' :
      ↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 >CF.cocone E' : 
      ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL ↦↦Cα ℭ ⟹
      ∃!f'. f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = f' ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
  shows "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
proof-
  let ?op_II = ‹↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL› 
    and ?op_II_II = ‹↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤›
    and ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL›
    and ?II_II = ‹↑↑→↑↑ (op_cat ℭ) 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣›
  interpret ε: is_cat_cocone α E ?op_II ℭ ?op_II_II ε by (rule assms(1))
  interpret par: cf_parallel α 𝔟PL 𝔞PL 𝔣PL  𝔤PL 𝔟 𝔞 𝔣 𝔤 ℭ
    by (rule ε.NTDom.HomCod.cat_cf_parallel_cat_coequalizer[OF assms(2,3)])
  interpret op_par: cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ‹op_cat ℭ›
    by (rule par.cf_parallel_op)
  have assms_4': 
    "∃!f'. f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aop_cat ℭ f'"
    if "ε' : E' <CF.cone ?II_II : ?II ↦↦Cα op_cat ℭ" for ε' E'
  proof-
    have [cat_op_simps]:
      "f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aop_cat ℭ f' ⟷
        f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = f' ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
      for f'
      by (intro iffI conjI; (elim conjE)?)
        (
          cs_concl 
            cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_parallel_cs_intros
        )+
    interpret ε': is_cat_cone α E' ?II ‹op_cat ℭ› ?II_II ε' by (rule that)
    show ?thesis
      unfolding cat_op_simps
      by 
        (
          rule assms(4)[
            OF ε'.is_cat_cocone_op[unfolded cat_op_simps], 
            unfolded cat_op_simps
            ]
        )
  qed
  interpret op_ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ‹op_cat ℭ› E ‹op_ntcf ε› 
    by 
      (
        rule 
          is_cat_equalizerI'
            [
              OF ε.is_cat_cone_op[unfolded cat_op_simps], 
              unfolded cat_op_simps, 
              OF assms(2,3) assms_4'
            ]
      )
  show ?thesis by (rule op_ε.is_cat_coequalizer_op[unfolded cat_op_simps])
qed

lemma (in is_cat_equalizer) cat_eq_unique_cone:
  assumes "ε' :
    E' <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
    (is ‹ε' : E' <CF.cone ?II_II : ?II ↦↦Cα ℭ›)
  shows "∃!f'. f' : E' ↦ℭ E ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f'"
proof-
  interpret ε': is_cat_cone α E' ?II ℭ ?II_II ε' by (rule assms(1))
  from cat_lim_unique_cone[OF assms(1)] obtain f' where f': "f' : E' ↦ℭ E"
    and ε'_def: "ε' = ε ∙NTCF ntcf_const ?II ℭ f'"
    and unique: 
      "⟦ f'' : E' ↦ℭ E; ε' = ε ∙NTCF ntcf_const ?II ℭ f'' ⟧ ⟹ f'' = f'" 
    for f''
    by auto
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show f': "f' : E' ↦ℭ E" by (rule f')
    from ε'_def have "ε'⦇NTMap⦈⦇𝔞PL⦈ = (ε ∙NTCF ntcf_const ?II ℭ f')⦇NTMap⦈⦇𝔞PL⦈"
      by simp
    from this f' show ε'_NTMap_app_I: "ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f'"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
        )
    fix f'' assume prems: 
      "f'' : E' ↦ℭ E" "ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f''"
    have "ε' = ε ∙NTCF ntcf_const ?II ℭ f''"
    proof(rule ntcf_eqI[OF ])
      show "ε' : cf_const ?II ℭ E' ↦CF ?II_II : ?II ↦↦Cα ℭ"
        by (rule ε'.is_ntcf_axioms)
      from f' prems(1) show "ε ∙NTCF ntcf_const ?II ℭ f'' :
        cf_const ?II ℭ E' ↦CF ?II_II : ?II ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "ε'⦇NTMap⦈ = (ε ∙NTCF ntcf_const ?II ℭ f'')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold cat_cs_simps)
        show "vsv ((ε ∙NTCF ntcf_const ?II ℭ f'')⦇NTMap⦈)"
          by (cs_concl cs_intro: cat_cs_intros)
        from prems(1) show 
          "?II⦇Obj⦈ = 𝒟∘ ((ε ∙NTCF ntcf_const ?II ℭ f'')⦇NTMap⦈)"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        fix a assume prems': "a ∈∘ ?II⦇Obj⦈"
        note [cat_cs_simps] = 
          cat_eq_2_eps_NTMap_app
          cat_cone_cf_par_eps_NTMap_app[
            OF ε'.is_cat_cone_axioms cf_parallel_𝔤' cf_parallel_𝔣'
            ]
        from prems' prems(1) have [cat_cs_simps]: 
          "ε'⦇NTMap⦈⦇a⦈ = ε⦇NTMap⦈⦇a⦈ ∘Aℭ f''"
          by (elim the_cat_parallel_ObjE; simp only:)
            (
                cs_concl 
                  cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
                  cs_intro: cat_cs_intros cat_parallel_cs_intros
            )+
        from prems' prems show 
          "ε'⦇NTMap⦈⦇a⦈ = (ε ∙NTCF ntcf_const ?II ℭ f'')⦇NTMap⦈⦇a⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed auto
    qed simp_all
    from unique[OF prems(1) this] show "f'' = f'" .      
  qed
qed

lemma (in is_cat_equalizer) cat_eq_unique:
  assumes "ε' : E' <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
  shows 
    "∃!f'. f' : E' ↦ℭ E ∧ ε' = ε ∙NTCF ntcf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ f'"
  by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])

lemma (in is_cat_equalizer) cat_eq_unique':
  assumes "ε' : E' <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
  shows "∃!f'. f' : E' ↦ℭ E ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f'"
proof-
  interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(1))
  show ?thesis by (rule cat_eq_unique_cone[OF ε'.is_cat_cone_axioms])
qed

lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
  assumes "ε' :
    ↑↑→↑↑ ℭ 𝔟PL 𝔞PL 𝔣PL 𝔤PL 𝔟 𝔞 𝔣 𝔤 >CF.cocone E' : ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL ↦↦Cα ℭ"
    (is ‹ε' : ?II_II >CF.cocone E' : ?II ↦↦Cα ℭ›)
  shows "∃!f'. f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = f' ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
proof-
  interpret ε': is_cat_cocone α E' ?II ℭ ?II_II ε' by (rule assms(1))
  have [cat_op_simps]:
    "f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aop_cat ℭ f' ⟷
      f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = f' ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈" 
    for f'
    by (intro iffI conjI; (elim conjE)?)
      (
        cs_concl
          cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros
      )+
  show ?thesis
    by 
      (
        rule is_cat_equalizer.cat_eq_unique_cone[
          OF is_cat_equalizer_op ε'.is_cat_cone_op[unfolded cat_op_simps],
          unfolded cat_op_simps
          ]
     )
qed

lemma (in is_cat_coequalizer) cat_coeq_unique:
  assumes "ε' : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E' : ↑↑2C ↦↦Cα ℭ"
  shows "∃!f'.
    f' : E ↦ℭ E' ∧
    ε' = ntcf_const (↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL) ℭ f' ∙NTCF ε"
  by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])

lemma (in is_cat_coequalizer) cat_coeq_unique':
  assumes "ε' : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E' : ↑↑2C ↦↦Cα ℭ"
  shows "∃!f'. f' : E ↦ℭ E' ∧ ε'⦇NTMap⦈⦇𝔞PL⦈ = f' ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
proof-
  interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(1))
  show ?thesis by (rule cat_coeq_unique_cocone[OF ε'.is_cat_cocone_axioms])
qed

lemma cat_equalizer_2_ex_is_arr_isomorphism:
  assumes "ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ" 
    and "ε' : E' <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
  obtains f where "f : E' ↦isoℭ E"
    and "ε' = ε ∙NTCF ntcf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ f"
proof-
  interpret ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
  interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF ε.is_cat_limit_axioms ε'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_equalizer_2_ex_is_arr_isomorphism':
  assumes "ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ" 
    and "ε' : E' <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
  obtains f where "f : E' ↦isoℭ E"
    and "ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f"
    and "ε'⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔟PL⦈ ∘Aℭ f"
proof-
  interpret ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
  interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
  obtain f where f: "f : E' ↦isoℭ E"
    and "j ∈∘ ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL⦇Obj⦈ ⟹ ε'⦇NTMap⦈⦇j⦈ = ε⦇NTMap⦈⦇j⦈ ∘Aℭ f" for j
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF ε.is_cat_limit_axioms ε'.is_cat_limit_axioms
          ]
      )
  then have 
    "ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ f"
    "ε'⦇NTMap⦈⦇𝔟PL⦈ = ε⦇NTMap⦈⦇𝔟PL⦈ ∘Aℭ f"
    unfolding the_cat_parallel_components by auto
  with f show ?thesis using that by simp
qed

lemma cat_coequalizer_2_ex_is_arr_isomorphism:
  assumes "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
    and "ε' : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E' : ↑↑2C ↦↦Cα ℭ"
  obtains f where "f : E ↦isoℭ E'" 
    and "ε' = ntcf_const (↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL)  ℭ f ∙NTCF ε"
proof-
  interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
  interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF ε.is_cat_colimit_axioms ε'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_coequalizer_2_ex_is_arr_isomorphism':
  assumes "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
    and "ε' : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E' : ↑↑2C ↦↦Cα ℭ"
  obtains f where "f : E ↦isoℭ E'" 
    and "ε'⦇NTMap⦈⦇𝔞PL⦈ = f ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
    and "ε'⦇NTMap⦈⦇𝔟PL⦈ = f ∘Aℭ ε⦇NTMap⦈⦇𝔟PL⦈"
proof-
  interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
  interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
  obtain f where f: "f : E ↦isoℭ E'"
    and "j ∈∘ ↑↑C 𝔟PL 𝔞PL 𝔣PL 𝔤PL⦇Obj⦈ ⟹ ε'⦇NTMap⦈⦇j⦈ = f ∘Aℭ ε⦇NTMap⦈⦇j⦈" for j
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF ε.is_cat_colimit_axioms ε'.is_cat_colimit_axioms
          ]
      )
  then have 
    "ε'⦇NTMap⦈⦇𝔞PL⦈ = f ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈"
    "ε'⦇NTMap⦈⦇𝔟PL⦈ = f ∘Aℭ ε⦇NTMap⦈⦇𝔟PL⦈"
    unfolding the_cat_parallel_components by auto
  with f show ?thesis using that by simp
qed



subsection‹Projection cone›


subsubsection‹Definition and elementary properties›

definition ntcf_obj_prod_base :: "V ⇒ V ⇒ (V ⇒ V) ⇒ V ⇒ (V ⇒ V) ⇒ V"
  where "ntcf_obj_prod_base ℭ I F P f =
    [(λj∈∘:C I⦇Obj⦈. f j), cf_const (:C I) ℭ P, :→: I F ℭ, :C I, ℭ]∘"


text‹Components.›

lemma ntcf_obj_prod_base_components:
  shows "ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈ = (λj∈∘:C I⦇Obj⦈. f j)"
    and "ntcf_obj_prod_base ℭ I F P f⦇NTDom⦈ = cf_const (:C I) ℭ P"
    and "ntcf_obj_prod_base ℭ I F P f⦇NTCod⦈ = :→: I F ℭ"
    and "ntcf_obj_prod_base ℭ I F P f⦇NTDGDom⦈ = :C I"
    and "ntcf_obj_prod_base ℭ I F P f⦇NTDGCod⦈ = ℭ"
  unfolding ntcf_obj_prod_base_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Natural transformation map›

mk_VLambda ntcf_obj_prod_base_components(1)
  |vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]|


subsubsection‹Projection natural transformation is a cone›

lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
  assumes "P ∈∘ ℭ⦇Obj⦈" and "⋀a. a ∈∘ I ⟹ f a : P ↦ℭ F a"
  shows "ntcf_obj_prod_base ℭ I F P f : P <CF.cone :→: I F ℭ : :C I ↦↦Cα ℭ"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
  from assms(2) have [cat_cs_intros]: 
    "⟦ a ∈∘ I; P' = P; Fa = F a ⟧ ⟹ f a : P' ↦ℭ Fa" for a P' Fa 
    by simp
  show "vfsequence (ntcf_obj_prod_base ℭ I F P f)"
    unfolding ntcf_obj_prod_base_def by auto
  show "vcard (ntcf_obj_prod_base ℭ I F P f) = 5ℕ"
    unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
  from assms show "cf_const (:C I) ℭ P : :C I ↦↦Cα ℭ"
    by 
      (
        cs_concl
          cs_intro: 
            cf_discrete_vdomain_vsubset_Vset 
            cat_discrete_cs_intros 
            cat_cs_intros
      )
  show ":→: I F ℭ : :C I ↦↦Cα ℭ"
    by (cs_concl cs_intro: cat_discrete_cs_intros)
  show "ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇a⦈ :
    cf_const (:C I) ℭ P⦇ObjMap⦈⦇a⦈ ↦ℭ :→: I F ℭ⦇ObjMap⦈⦇a⦈"
    if "a ∈∘ :C I⦇Obj⦈" for a
  proof-
    from that have "a ∈∘ I" unfolding the_cat_discrete_components by simp
    from that this show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
        )
  qed
  show 
    "ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇b⦈ ∘Aℭ
      cf_const (:C I) ℭ P⦇ArrMap⦈⦇g⦈ =
      :→: I F ℭ⦇ArrMap⦈⦇g⦈ ∘Aℭ ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇a⦈"
    if "g : a ↦:C I b" for a b g
  proof-
    note g = the_cat_discrete_is_arrD[OF that]
    from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
      unfolding g(7-9)
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_discrete_cs_simps 
            cs_intro: 
              cf_discrete_vdomain_vsubset_Vset 
              cat_cs_intros cat_discrete_cs_intros
        )
  qed
  from assms(1) show "cf_const (:C I) ℭ P : :C I ↦↦C.tmα ℭ"
    by 
      (
        cs_concl cs_intro: 
          cat_cs_intros cat_small_cs_intros cat_small_discrete_cs_intros
      )
qed 
  (
    auto simp: 
      assms 
      ntcf_obj_prod_base_components 
      tm_cf_discrete_the_cf_discrete_is_tm_functor
  )

lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
  assumes "P ∈∘ ℭ⦇Obj⦈" 
    and "⋀a. a ∈∘ I ⟹ f a : P ↦ℭ F a"
    and "⋀u' r'.
      ⟦ u' : r' <CF.cone :→: I F ℭ : :C I ↦↦Cα ℭ ⟧ ⟹ 
        ∃!f'.
          f' : r' ↦ℭ P ∧
          u' = ntcf_obj_prod_base ℭ I F P f ∙NTCF ntcf_const (:C I) ℭ f'"
  shows "ntcf_obj_prod_base ℭ I F P f : P <CF.∏ F : I ↦↦Cα ℭ"
proof
  (
    intro 
      is_cat_obj_prodI 
      is_cat_limitI' 
      tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified] 
      assms(1,3)
  )
  show "cf_discrete α I F ℭ"
    by (cs_concl cs_intro: cat_small_discrete_cs_intros)
qed



subsection‹Equalizer cone›


subsubsection‹Definition and elementary properties›

definition ntcf_equalizer_base :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
  where "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e =
    [
      (λx∈∘↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL⦇Obj⦈. e x),
      cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E,
      ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣,
      ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL,
      ℭ
    ]∘"


text‹Components.›

lemma ntcf_equalizer_base_components:
  shows "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈ =
    (λx∈∘↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL⦇Obj⦈. e x)"
    and [cat_lim_cs_simps]: "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDom⦈ =
      cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E"
    and [cat_lim_cs_simps]: "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTCod⦈ =
      ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣"
    and [cat_lim_cs_simps]: 
      "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDGDom⦈ = ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL"
    and [cat_lim_cs_simps]: 
      "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDGCod⦈ = ℭ"
  unfolding ntcf_equalizer_base_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Natural transformation map›

mk_VLambda ntcf_equalizer_base_components(1)
  |vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]|
  |vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]|
  |app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]|


subsubsection‹Equalizer cone is a cone›

lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
  assumes "e 𝔞PL : E ↦ℭ 𝔞"
    and "e 𝔟PL : E ↦ℭ 𝔟"
    and "e 𝔟PL = 𝔤 ∘Aℭ e 𝔞PL"
    and "e 𝔟PL = 𝔣 ∘Aℭ e 𝔞PL"
    and "𝔤 : 𝔞 ↦ℭ 𝔟"
    and "𝔣 : 𝔞 ↦ℭ 𝔟"
  shows "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e :
    E <CF.cone ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 :
    ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
proof-
  interpret par: cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 ℭ 
    by (intro cf_parallelI cat_parallelI assms(5,6))
      (simp_all add: cat_parallel_cs_intros cat_cs_intros)
  show ?thesis
  proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
    show "vfsequence (ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e)"
      unfolding ntcf_equalizer_base_def by auto
    show "vcard (ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e) = 5ℕ"
      unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
    from assms(2) show 
      "cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦C.tmα ℭ"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
        )
    then show "cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
      by (cs_concl cs_intro: cat_small_cs_intros)
    from assms show 
      "↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦C.tmα ℭ"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_parallel_cs_intros)
    then show "↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣 : ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL ↦↦Cα ℭ"
      by (cs_concl cs_intro: cat_small_cs_intros)
    show 
      "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇i⦈ :
        cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E⦇ObjMap⦈⦇i⦈ ↦ℭ
        ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣⦇ObjMap⦈⦇i⦈"
      if "i ∈∘ ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL⦇Obj⦈" for i 
    proof-
      from that assms(1,2,5,6) show ?thesis
        by (elim the_cat_parallel_ObjE; simp only:)
          ( 
            cs_concl 
              cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
    qed
    show 
      "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇b'⦈ ∘Aℭ
        cf_const (↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL) ℭ E⦇ArrMap⦈⦇f'⦈ =
          ↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣⦇ArrMap⦈⦇f'⦈ ∘Aℭ
          ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇a'⦈"
      if "f' : a' ↦↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL b'" for a' b' f'
      using that assms(1,2,5,6)
      by (elim par.the_cat_parallel_is_arrE; simp only:)
        (
          cs_concl 
            cs_simp: 
              cat_cs_simps 
              cat_lim_cs_simps 
              cat_parallel_cs_simps 
              assms(3,4)[symmetric]
            cs_intro: cat_parallel_cs_intros
        )+
  qed 
    (
      use assms(2) in 
        ‹
          cs_concl
            cs_intro: cat_lim_cs_intros cat_cs_intros 
            cs_simp: cat_lim_cs_simps
        ›
    )+
qed



subsection‹Limits by products and equalizers›

lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
  ―‹See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.›
  assumes "𝔉 : 𝔍 ↦↦C.tmα ℭ"
    and "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔞 ↦ℭ 𝔟; 𝔤 : 𝔞 ↦ℭ 𝔟 ⟧ ⟹
      ∃E ε. ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
    and "⋀A. tm_cf_discrete α (𝔍⦇Obj⦈) A ℭ ⟹
      ∃P π. π : P <CF.∏ A : 𝔍⦇Obj⦈ ↦↦Cα ℭ"
    and "⋀A. tm_cf_discrete α (𝔍⦇Arr⦈) A ℭ ⟹
      ∃P π. π : P <CF.∏ A : 𝔍⦇Arr⦈ ↦↦Cα ℭ"
  obtains r u where "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
proof-

  let ?L =‹λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› and ?R =‹λi. 𝔉⦇ObjMap⦈⦇i⦈›
  
  interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 by (rule assms(1))

  have "?R j ∈∘ ℭ⦇Obj⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by (cs_concl cs_intro: cat_cs_intros that)

  have "tm_cf_discrete α (𝔍⦇Obj⦈) ?R ℭ"
  proof(intro tm_cf_discreteI)
    show "𝔉⦇ObjMap⦈⦇i⦈ ∈∘ ℭ⦇Obj⦈" if "i ∈∘ 𝔍⦇Obj⦈" for i
      by (cs_concl cs_intro: cat_cs_intros that)
    show "VLambda (𝔍⦇Obj⦈) ?R ∈∘ Vset α"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "ℛ∘ (VLambda (𝔍⦇Obj⦈) ?R) ∈∘ Vset α"
      proof-
        have "ℛ∘ (VLambda (𝔍⦇Obj⦈) ?R) ⊆∘ ℛ∘ (𝔉⦇ObjMap⦈)"
          by (auto simp: 𝔉.cf_ObjMap_vdomain)
        moreover have "ℛ∘ (𝔉⦇ObjMap⦈) ∈∘ Vset α"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
    show "(λi∈∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ∈∘ Vset α"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "ℛ∘ (λi∈∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ∈∘ Vset α"
      proof-
        have "ℛ∘ (λi∈∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ⊆∘ ℛ∘ (𝔉⦇ArrMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix x assume x: "x ∈∘ 𝔍⦇Obj⦈"
          then have "𝔍⦇CId⦈⦇x⦈ ∈∘ 𝒟∘ (𝔉⦇ArrMap⦈)"
            by (auto intro: cat_cs_intros simp: cat_cs_simps)
          moreover from x have "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ = 𝔉⦇ArrMap⦈⦇𝔍⦇CId⦈⦇x⦈⦈"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          ultimately show "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∈∘ ℛ∘ (𝔉⦇ArrMap⦈)"
            by (simp add: 𝔉.ArrMap.vsv_vimageI2)
        qed
        moreover have "ℛ∘ (𝔉⦇ArrMap⦈) ∈∘ Vset α"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
  qed (auto intro: cat_cs_intros)

  from assms(3)[where A=‹?R›, OF this] obtain PO πO
    where πO: "πO : PO <CF.∏ ?R : 𝔍⦇Obj⦈ ↦↦Cα ℭ"
    by clarsimp

  interpret πO: is_cat_obj_prod α ‹𝔍⦇Obj⦈› ?R ℭ PO πO by (rule πO)

  have PO: "PO ∈∘ ℭ⦇Obj⦈" by (intro πO.cat_cone_obj)

  have "?L u ∈∘ ℭ⦇Obj⦈" if "u ∈∘ 𝔍⦇Arr⦈" for u
  proof-
    from that obtain a b where "u : a ↦𝔍 b" by auto
    then show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed

  have tm_cf_discrete: "tm_cf_discrete α (𝔍⦇Arr⦈) ?L ℭ"
  proof(intro tm_cf_discreteI)
    show "𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ ∈∘ ℭ⦇Obj⦈" if "f ∈∘ 𝔍⦇Arr⦈" for f
    proof-
      from that obtain a b where "f : a ↦𝔍 b" by auto
      then show ?thesis 
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
 
    show "(λu∈∘𝔍⦇Arr⦈. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈) ∈∘ Vset α"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "ℛ∘ (λu∈∘𝔍⦇Arr⦈. ?L u) ∈∘ Vset α"
      proof-
        have "ℛ∘ (λu∈∘𝔍⦇Arr⦈. ?L u) ⊆∘ ℛ∘ (𝔉⦇ObjMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix f assume "f ∈∘ 𝔍⦇Arr⦈"
          then obtain a b where "f : a ↦𝔍 b" by auto
          then show "𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ ∈∘ ℛ∘ (𝔉⦇ObjMap⦈)"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
              )
        qed
        moreover have "ℛ∘ (𝔉⦇ObjMap⦈) ∈∘ Vset α"
          by (auto intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)

    show "(λi∈∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ∈∘ Vset α"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "ℛ∘ (λi∈∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ∈∘ Vset α"
      proof-
        have "ℛ∘ (λi∈∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ⊆∘ ℛ∘ (𝔉⦇ArrMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix f assume "f ∈∘ 𝔍⦇Arr⦈"
          then obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "𝔍⦇CId⦈⦇b⦈ ∈∘ 𝒟∘ (𝔉⦇ArrMap⦈)"
            by (auto intro: cat_cs_intros simp: cat_cs_simps)
          moreover from f have 
            "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈⦈ = 𝔉⦇ArrMap⦈⦇𝔍⦇CId⦈⦇b⦈⦈"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          ultimately show "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈⦈ ∈∘ ℛ∘ (𝔉⦇ArrMap⦈)"
            by (simp add: 𝔉.ArrMap.vsv_vimageI2)
        qed
        moreover have "ℛ∘ (𝔉⦇ArrMap⦈) ∈∘ Vset α"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
  qed (auto intro: cat_cs_intros)

  from assms(4)[where A=‹?L›, OF this, simplified] obtain PA πA
    where πA: "πA : PA <CF.∏ ?L : 𝔍⦇Arr⦈ ↦↦Cα ℭ"
    by auto

  interpret πA: is_cat_obj_prod α ‹𝔍⦇Arr⦈› ?L ℭ PA πA by (rule πA)

  let ?F = ‹λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› and ?f = ‹λu. πO⦇NTMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› 
  let ?πO' = ‹ntcf_obj_prod_base ℭ (:C (𝔍⦇Arr⦈)⦇Obj⦈) ?F PO ?f›

  have πO': "?πO' :
    PO <CF.cone :→: (𝔍⦇Arr⦈) (λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈) ℭ :
    :C (𝔍⦇Arr⦈) ↦↦Cα ℭ"
    unfolding the_cat_discrete_components(1)
  proof
    (
      intro 
        tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
        tm_cf_discrete
    )
    fix f assume "f ∈∘ 𝔍⦇Arr⦈"
    then obtain a b where "f : a ↦𝔍 b" by auto
    then show "πO⦇NTMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ : PO ↦ℭ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
      by 
        (
          cs_concl
            cs_simp:
              the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
            cs_intro: cat_cs_intros
        )
  qed (intro PO)

  from πA.cat_obj_prod_unique_cone'[OF πO'] obtain f' 
    where f': "f' : PO ↦ℭ PA"
      and πO'_NTMap_app: 
        "⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?πO'⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ f'"
      and unique_f':
        "⟦
          f'' : PO ↦ℭ PA;
          ⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?πO'⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ f''
         ⟧ ⟹ f'' = f'"
      for f''
    by metis

  have πO_NTMap_app_Cod: 
    "πO⦇NTMap⦈⦇b⦈ = πA⦇NTMap⦈⦇f⦈ ∘Aℭ f'" if "f : a ↦𝔍 b" for f a b 
  proof-
    from that have "f ∈∘ 𝔍⦇Arr⦈" by auto
    from πO'_NTMap_app[OF this] that show ?thesis
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps the_cat_discrete_components(1)
            cs_intro: cat_cs_intros
        )
  qed

  from this[symmetric] have πA_NTMap_Comp_app: 
    "πA⦇NTMap⦈⦇f⦈ ∘Aℭ (f' ∘Aℭ q) = πO⦇NTMap⦈⦇b⦈ ∘Aℭ q" 
    if "f : a ↦𝔍 b" and "q : c ↦ℭ PO" for q f a b c 
    using that f'
    by (intro 𝔉.HomCod.cat_assoc_helper)
      (
        cs_concl 
          cs_simp: 
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
          cs_intro: cat_cs_intros
      )+

  let ?g = ‹λu. 𝔉⦇ArrMap⦈⦇u⦈ ∘Aℭ πO⦇NTMap⦈⦇𝔍⦇Dom⦈⦇u⦈⦈› 
  let ?πO'' = ‹ntcf_obj_prod_base ℭ (:C (𝔍⦇Arr⦈)⦇Obj⦈) ?F PO ?g›
  
  have πO'': "?πO'' : PO <CF.cone :→: (𝔍⦇Arr⦈) ?L ℭ : :C (𝔍⦇Arr⦈) ↦↦Cα ℭ"
    unfolding the_cat_discrete_components(1)
  proof
    (
      intro 
        tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone  
        tm_cf_discrete
    )
    show "𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ πO⦇NTMap⦈⦇𝔍⦇Dom⦈⦇f⦈⦈ : PO ↦ℭ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
      if "f ∈∘ 𝔍⦇Arr⦈" for f
    proof-
      from that obtain a b where "f : a ↦𝔍 b"  by auto
      then show ?thesis
        by  
          (
            cs_concl 
              cs_simp: 
                cat_cs_simps cat_discrete_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros
          )
    qed
  qed (intro PO)

  from πA.cat_obj_prod_unique_cone'[OF πO''] obtain g' 
    where g': "g' : PO ↦ℭ PA"
      and πO''_NTMap_app: 
        "⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?πO''⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ g'"
      and unique_g':
        "⟦
          g'' : PO ↦ℭ PA;
          ⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?πO''⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ g''
         ⟧ ⟹ g'' = g'"
      for g''
    by (metis (lifting))

  have "𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ πO⦇NTMap⦈⦇a⦈ = πA⦇NTMap⦈⦇f⦈ ∘Aℭ g'" 
    if "f : a ↦𝔍 b" for f a b 
  proof-
    from that have "f ∈∘ 𝔍⦇Arr⦈" by auto
    from πO''_NTMap_app[OF this] that show ?thesis
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps the_cat_discrete_components(1)
            cs_intro: cat_cs_intros
        )
  qed
  then have πO_NTMap_app_Dom: 
    "𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ (πO⦇NTMap⦈⦇a⦈ ∘Aℭ q) =
      (πA⦇NTMap⦈⦇f⦈ ∘Aℭ g') ∘Aℭ q" 
    if "f : a ↦𝔍 b" and "q : c ↦ℭ  PO" for q f a b c 
    using that g' 
    by (intro 𝔉.HomCod.cat_assoc_helper)
      (
        cs_concl 
          cs_simp: 
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
          cs_intro: cat_cs_intros
      )

  from assms(2)[OF f' g'] obtain E ε where ε: 
    "ε : E <CF.eq (PO,PA,g',f') : ↑↑2C ↦↦Cα ℭ"
    by clarsimp

  interpret ε: is_cat_equalizer α PO PA g' f' ℭ E ε by (rule ε)

  define μ where "μ =
    [(λi∈∘𝔍⦇Obj⦈. πO⦇NTMap⦈⦇i⦈ ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈), cf_const 𝔍 ℭ E, 𝔉, 𝔍, ℭ]∘"

  have μ_components:
    "μ⦇NTMap⦈ = (λi∈∘𝔍⦇Obj⦈. πO⦇NTMap⦈⦇i⦈ ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈)"
    "μ⦇NTDom⦈ = cf_const 𝔍 ℭ E"
    "μ⦇NTCod⦈ = 𝔉"
    "μ⦇NTDGDom⦈ = 𝔍"
    "μ⦇NTDGCod⦈ = ℭ"
    unfolding μ_def nt_field_simps by (simp_all add: nat_omega_simps)

  have [cat_cs_simps]: 
    "μ⦇NTMap⦈⦇i⦈ = πO⦇NTMap⦈⦇i⦈ ∘Aℭ ε⦇NTMap⦈⦇𝔞PL⦈" if "i ∈∘ 𝔍⦇Obj⦈" 
    for i
    using that unfolding μ_components by simp

  have "μ : E <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  proof(intro is_cat_limitI')

    show μ: "μ : E <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ" 
    proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
      show "vfsequence μ" unfolding μ_def by simp 
      show "vcard μ = 5ℕ" unfolding μ_def by (simp add: nat_omega_simps)
      show "cf_const 𝔍 ℭ E : 𝔍 ↦↦Cα ℭ"
        by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
      show "𝔉 : 𝔍 ↦↦Cα ℭ" by (cs_concl cs_intro: cat_cs_intros)
      show "μ⦇NTMap⦈⦇a⦈ : cf_const 𝔍 ℭ E⦇ObjMap⦈⦇a⦈ ↦ℭ 𝔉⦇ObjMap⦈⦇a⦈"
        if "a ∈∘ 𝔍⦇Obj⦈" for a
        using that
        by 
          (
            cs_concl 
              cs_simp: 
                cat_cs_simps 
                cat_discrete_cs_simps 
                cat_parallel_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
          )
      show 
        "μ⦇NTMap⦈⦇b⦈ ∘Aℭ cf_const 𝔍 ℭ E⦇ArrMap⦈⦇f⦈ =
          𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ μ⦇NTMap⦈⦇a⦈"
        if "f : a ↦𝔍 b" for a b f
        using that ε g' f' 
        by 
          (
            cs_concl
              cs_simp:
                cat_parallel_cs_simps
                cat_cs_simps 
                the_cat_discrete_components(1) 
                πO_NTMap_app_Cod 
                πO_NTMap_app_Dom 
                ε.cat_eq_Comp_eq(1) 
              cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
          )
      show "cf_const 𝔍 ℭ E : 𝔍 ↦↦C.tmα ℭ"
        by 
          (
            cs_concl cs_simp: cs_intro: 
              cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
          )
      show "𝔉 : 𝔍 ↦↦C.tmα ℭ"
        by (cs_concl cs_simp: cs_intro: cat_small_cs_intros)

    qed (auto simp: μ_components cat_lim_cs_intros)

    interpret μ: is_cat_cone α E 𝔍 ℭ 𝔉 μ by (rule μ)

    show "∃!f'. f' : r' ↦ℭ E ∧ u' = μ ∙NTCF ntcf_const 𝔍 ℭ f'"
      if "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦Cα ℭ" for u' r'
    proof-

      interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 u' by (rule that)

      let ?u' = ‹λj. u'⦇NTMap⦈⦇j⦈› 
      let ?π' = ‹ntcf_obj_prod_base ℭ (𝔍⦇Obj⦈) ?R r' ?u'›

      have π'_NTMap_app: "?π'⦇NTMap⦈⦇j⦈ = u'⦇NTMap⦈⦇j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
        using that 
        unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
        by auto

      have π': "?π' : r' <CF.cone :→: (𝔍⦇Obj⦈) ?R ℭ : :C (𝔍⦇Obj⦈) ↦↦Cα ℭ"
        unfolding the_cat_discrete_components(1)
      proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
        show "tm_cf_discrete α (𝔍⦇Obj⦈) ?R ℭ"
        proof(intro tm_cf_discreteI)
          show "𝔉⦇ObjMap⦈⦇i⦈ ∈∘ ℭ⦇Obj⦈" if "i ∈∘ 𝔍⦇Obj⦈" for i
            using that 
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        qed
          (
            auto intro: 
              cat_cs_intros
              PO 
              πO.NTCod.tm_cf_ArrMap_in_Vset[unfolded the_cf_discrete_components]
              πO.NTCod.tm_cf_ObjMap_in_Vset[unfolded the_cf_discrete_components]
          )
        show "u'⦇NTMap⦈⦇j⦈ : r' ↦ℭ 𝔉⦇ObjMap⦈⦇j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
          using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed (auto simp: cat_lim_cs_intros)

      from πO.cat_obj_prod_unique_cone'[OF this] obtain h' 
        where h': "h' : r' ↦ℭ PO"
          and π'_NTMap_app': 
            "⋀j. j ∈∘ (𝔍⦇Obj⦈) ⟹ ?π'⦇NTMap⦈⦇j⦈ = πO⦇NTMap⦈⦇j⦈ ∘Aℭ h'"
          and unique_h': "⋀h''.
            ⟦ 
              h'' : r' ↦ℭ PO;
              ⋀j. j ∈∘ (𝔍⦇Obj⦈) ⟹ ?π'⦇NTMap⦈⦇j⦈ = πO⦇NTMap⦈⦇j⦈ ∘Aℭ h'' 
            ⟧ ⟹ h'' = h'"
        by metis

      interpret π':
        is_cat_cone α r' ‹:C (𝔍⦇Obj⦈)› ℭ ‹:→: (𝔍⦇Obj⦈) (app (𝔉⦇ObjMap⦈)) ℭ› ?π'
        by (rule π')

      let ?u'' = ‹λu. u'⦇NTMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› 
      let ?π'' = ‹ntcf_obj_prod_base ℭ (𝔍⦇Arr⦈) ?L r' ?u''›

      have π''_NTMap_app: "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
        if "f : a ↦𝔍 b" for f a b 
        using that 
        unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
        by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
      
      have π'': "?π'' : r' <CF.cone :→: (𝔍⦇Arr⦈) ?L ℭ : :C (𝔍⦇Arr⦈) ↦↦Cα ℭ"
        unfolding the_cat_discrete_components(1)
      proof
        (
          intro 
            tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
            tm_cf_discrete
        )
        fix f assume "f ∈∘ 𝔍⦇Arr⦈"
        then obtain a b where "f : a ↦𝔍 b" by auto
        then show "u'⦇NTMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ : r' ↦ℭ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed (simp add: cat_lim_cs_intros)

      from πA.cat_obj_prod_unique_cone'[OF this] obtain h'' 
        where h'': "h'' : r' ↦ℭ PA"
          and π''_NTMap_app': 
            "⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?π''⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ h''"
          and unique_h'': "⋀h'''.
            ⟦ 
              h''' : r' ↦ℭ PA;
              ⋀j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?π''⦇NTMap⦈⦇j⦈ = πA⦇NTMap⦈⦇j⦈ ∘Aℭ h''' 
            ⟧ ⟹ h''' = h''"
        by metis

      interpret π'': is_cat_cone α r' ‹:C (𝔍⦇Arr⦈)› ℭ ‹:→: (𝔍⦇Arr⦈) ?L ℭ› ?π''
        by (rule π'')

      have g'h'_f'h': "g' ∘Aℭ h' = f' ∘Aℭ h'"  
      proof-

        from g' h' have g'h': "g' ∘Aℭ h' : r' ↦ℭ PA"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from f' h' have f'h': "f' ∘Aℭ h' : r' ↦ℭ PA"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

        have "?π''⦇NTMap⦈⦇f⦈ = πA⦇NTMap⦈⦇f⦈ ∘Aℭ (g' ∘Aℭ h')"
          if "f ∈∘ 𝔍⦇Arr⦈" for f
        proof-
          from that obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
            by (cs_concl cs_simp: π''_NTMap_app cat_cs_simps)
          also from f have "… = 𝔉⦇ArrMap⦈⦇f⦈ ∘Aℭ ?π'⦇NTMap⦈⦇a⦈"
            by 
              (
                cs_concl 
                  cs_simp: π'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
              )
          also from f g' h' have "… = πA⦇NTMap⦈⦇f⦈ ∘Aℭ (g' ∘Aℭ h')" 
            by 
              (
                cs_concl
                  cs_simp: 
                    cat_cs_simps 
                    cat_discrete_cs_simps
                    the_cat_discrete_components(1) 
                    π'_NTMap_app'
                    πO_NTMap_app_Dom 
                  cs_intro: cat_cs_intros
              )
          finally show ?thesis by simp
        qed
          
        from unique_h''[OF g'h' this, simplified] have g'h'_h'': 
          "g' ∘Aℭ h' = h''".
        have "?π''⦇NTMap⦈⦇f⦈ = πA⦇NTMap⦈⦇f⦈ ∘Aℭ (f' ∘Aℭ h')"
          if "f ∈∘ 𝔍⦇Arr⦈" for f
        proof-
          from that obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
            by (cs_concl cs_simp: π''_NTMap_app cat_cs_simps)
          also from f have "… = ?π'⦇NTMap⦈⦇b⦈"
            by (cs_concl cs_simp: π'_NTMap_app cs_intro: cat_cs_intros)
          also from f have "… = πO⦇NTMap⦈⦇b⦈ ∘Aℭ h'"
            by (cs_concl cs_simp: π'_NTMap_app' cs_intro: cat_cs_intros)
          also from f g' h' have "… = (πA⦇NTMap⦈⦇f⦈ ∘Aℭ f') ∘Aℭ h'"
            by (cs_concl cs_simp: πO_NTMap_app_Cod cs_intro: cat_cs_intros)
          also from that f' h' have "… = πA⦇NTMap⦈⦇f⦈ ∘Aℭ (f' ∘Aℭ h')"
            by 
              (
                cs_concl
                  cs_simp: cat_cs_simps the_cat_discrete_components(1) 
                  cs_intro: cat_cs_intros
               )
          finally show ?thesis by simp
        qed
        from unique_h''[OF f'h' this, simplified] have f'h'_h'': 
          "f' ∘Aℭ h' = h''".
        from g'h'_h'' f'h'_h'' show ?thesis by simp
      qed

      let ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL› 
        and ?II_II = ‹↑↑→↑↑ ℭ 𝔞PL 𝔟PL 𝔤PL 𝔣PL PO PA g' f'›

    define ε' where "ε' =
      [
        (λf∈∘?II⦇Obj⦈. (f = 𝔞PL ? h' : (f' ∘Aℭ h'))),
        cf_const ?II ℭ r',
        ?II_II,
        ?II,
        ℭ
      ]∘"

    have ε'_components: 
      "ε'⦇NTMap⦈ = (λf∈∘?II⦇Obj⦈. (f = 𝔞PL ? h' : (f' ∘Aℭ h')))"
      "ε'⦇NTDom⦈ = cf_const ?II ℭ r'"
      "ε'⦇NTCod⦈ = ?II_II"
      "ε'⦇NTDGDom⦈ = ?II"
      "ε'⦇NTDGCod⦈ = ℭ"
      unfolding ε'_def nt_field_simps by (simp_all add: nat_omega_simps)

    have ε'_NTMap_app_I2: "ε'⦇NTMap⦈⦇x⦈ = h'" if "x = 𝔞PL" for x 
    proof-
      have "x ∈∘ ?II⦇Obj⦈"
        unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
      then show ?thesis unfolding ε'_components that by simp
    qed

    have ε'_NTMap_app_sI2: "ε'⦇NTMap⦈⦇x⦈ = f' ∘Aℭ h'" if "x = 𝔟PL" for x 
    proof-      
      have "x ∈∘ ?II⦇Obj⦈"
        unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
      with ε.cat_parallel_𝔞𝔟 show ?thesis
        unfolding ε'_components by (cs_concl cs_simp: V_cs_simps that)
    qed

    interpret par: cf_parallel α 𝔞PL 𝔟PL 𝔤PL 𝔣PL PO PA g' f' ℭ
      by (intro cf_parallelI cat_parallelI)
        (
          simp_all add: 
            cat_cs_intros cat_parallel_cs_intros cat_PL_ineq[symmetric]
        )

    have "ε' : r' <CF.cone ?II_II : ?II ↦↦Cα ℭ"
    proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
      show "vfsequence ε'" unfolding ε'_def by auto
      show "vcard ε' = 5ℕ" unfolding ε'_def by (simp add: nat_omega_simps)
      from h' show "cf_const (?II) ℭ r' : ?II ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "?II_II : ?II ↦↦Cα ℭ"
        by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros)
      from h' show "ε'⦇NTMap⦈⦇a⦈ : 
        cf_const ?II ℭ r'⦇ObjMap⦈⦇a⦈ ↦ℭ ?II_II⦇ObjMap⦈⦇a⦈"
        if "a ∈∘ ?II⦇Obj⦈" for a 
        using that
        by (elim the_cat_parallel_ObjE; simp only:)
          (
            cs_concl 
              cs_simp: 
                ε'_NTMap_app_I2 ε'_NTMap_app_sI2 
                cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
      from h' f' g'h'_f'h' show 
        "ε'⦇NTMap⦈⦇b⦈ ∘Aℭ cf_const ?II ℭ r'⦇ArrMap⦈⦇f⦈ =
          ?II_II⦇ArrMap⦈⦇f⦈ ∘Aℭ ε'⦇NTMap⦈⦇a⦈"
          if "f : a ↦?II b" for a b f
          using that
          by (elim ε.the_cat_parallel_is_arrE; simp only:)
            (
              cs_concl 
                cs_intro: cat_cs_intros cat_parallel_cs_intros 
                cs_simp:
                  cat_cs_simps
                  cat_parallel_cs_simps
                  ε'_NTMap_app_I2 
                  ε'_NTMap_app_sI2
            )+
      qed 
        (
          simp add: ε'_components | 
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros 
        )+
    from ε.cat_eq_unique_cone[OF this] obtain t'
      where t': "t' : r' ↦ℭ E"
        and ε'_NTMap_app: "ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ t'"
        and unique_t':
          "⟦ t'' : r' ↦ℭ E; ε'⦇NTMap⦈⦇𝔞PL⦈ = ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ t''⟧ ⟹ 
            t'' = t'" 
        for t''
      by metis

    show "∃!f'. f' : r' ↦ℭ E ∧ u' = μ ∙NTCF ntcf_const 𝔍 ℭ f'"
    proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
      show [symmetric, cat_cs_simps]: "u' = μ ∙NTCF ntcf_const 𝔍 ℭ t'"
      proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
        from t' show 
          "μ ∙NTCF ntcf_const 𝔍 ℭ t' : cf_const 𝔍 ℭ r' ↦CF 𝔉 : 𝔍 ↦↦Cα ℭ"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ = (μ ∙NTCF ntcf_const 𝔍 ℭ t')⦇NTMap⦈"
        proof(rule vsv_eqI)
          show "vsv ((μ ∙NTCF ntcf_const 𝔍 ℭ t')⦇NTMap⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          from t' show 
            "𝒟∘ (u'⦇NTMap⦈) = 𝒟∘ ((μ ∙NTCF ntcf_const 𝔍 ℭ t')⦇NTMap⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          show "u'⦇NTMap⦈⦇a⦈ = (μ ∙NTCF ntcf_const 𝔍 ℭ t')⦇NTMap⦈⦇a⦈"
            if "a ∈∘ 𝒟∘ (u'⦇NTMap⦈)" for a
          proof-
            from that have "a ∈∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)
            with t' show "u'⦇NTMap⦈⦇a⦈ = (μ ∙NTCF ntcf_const 𝔍 ℭ t')⦇NTMap⦈⦇a⦈"
              by 
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps 
                      π'_NTMap_app
                      cat_parallel_cs_simps
                      the_cat_discrete_components(1)
                      ε'_NTMap_app[symmetric]
                      ε'_NTMap_app_I2
                      π'_NTMap_app'[symmetric]
                    cs_intro: cat_cs_intros cat_parallel_cs_intros
                )
          qed
        qed auto
      qed simp_all

      fix t'' assume prems': 
        "t'' : r' ↦ℭ E" "u' = μ ∙NTCF ntcf_const 𝔍 ℭ t''"
      then have u'_NTMap_app_x:
        "u'⦇NTMap⦈⦇x⦈ = (μ ∙NTCF ntcf_const 𝔍 ℭ t'')⦇NTMap⦈⦇x⦈"
        for x 
        by simp
      have "?π'⦇NTMap⦈⦇j⦈ = πO⦇NTMap⦈⦇j⦈ ∘Aℭ (ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ t'')" 
        if "j ∈∘ 𝔍⦇Obj⦈" for j
        using u'_NTMap_app_x[of j] prems'(1) that
        by 
          (
            cs_prems 
              cs_simp:
                cat_cs_simps 
                cat_discrete_cs_simps 
                cat_parallel_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          ) 
          (simp add: π'_NTMap_app[OF that, symmetric])
      moreover from prems'(1) have "ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ t'' : r' ↦ℭ PO"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
      ultimately have [cat_cs_simps]: 
        "ε⦇NTMap⦈⦇𝔞PL⦈ ∘Aℭ t'' = h'" 
        by (intro unique_h') simp
      show "t'' = t'"
        by (rule unique_t', intro prems'(1)) 
          (cs_concl cs_simp: ε'_NTMap_app_I2 cat_cs_simps)
      qed
    qed
 
  qed
  
  then show ?thesis using that by clarsimp

qed

lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
  ―‹See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.›
  assumes "𝔉 : 𝔍 ↦↦C.tmα ℭ"
    and "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔟 ↦ℭ 𝔞; 𝔤 : 𝔟 ↦ℭ 𝔞 ⟧ ⟹
      ∃E ε. ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
    and "⋀A. tm_cf_discrete α (𝔍⦇Obj⦈) A ℭ ⟹
      ∃P π. π : A >CF.∐ P : 𝔍⦇Obj⦈ ↦↦Cα ℭ"
    and "⋀A. tm_cf_discrete α (𝔍⦇Arr⦈) A ℭ ⟹
      ∃P π. π : A >CF.∐ P : 𝔍⦇Arr⦈ ↦↦Cα ℭ"
  obtains r u where "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ"
proof-
  interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 by (rule assms(1))
  have "∃E ε. ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα op_cat ℭ"
    if "𝔣 : 𝔟 ↦ℭ 𝔞" "𝔤 : 𝔟 ↦ℭ 𝔞" for 𝔞 𝔟 𝔤 𝔣
  proof-
    from assms(2)[OF that(1,2)] obtain E ε 
      where ε: "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
      by clarsimp
    interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule ε)
    from ε.is_cat_equalizer_op[unfolded cat_op_simps] show ?thesis by auto
  qed
  moreover have "∃P π. π : P <CF.∏ A : 𝔍⦇Obj⦈ ↦↦Cα op_cat ℭ"
    if "tm_cf_discrete α (𝔍⦇Obj⦈) A (op_cat ℭ)" for A
  proof-
    interpret tm_cf_discrete α ‹𝔍⦇Obj⦈› A ‹op_cat ℭ› by (rule that)
    from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π 
      where π: "π : A >CF.∐ P : 𝔍⦇Obj⦈ ↦↦Cα ℭ"
      by clarsimp 
    interpret π: is_cat_obj_coprod α ‹𝔍⦇Obj⦈› A ℭ P π by (rule π)
    from π.is_cat_obj_prod_op show ?thesis by auto
  qed
  moreover have "∃P π. π : P <CF.∏ A : 𝔍⦇Arr⦈ ↦↦Cα op_cat ℭ"
    if "tm_cf_discrete α (𝔍⦇Arr⦈) A (op_cat ℭ)" for A 
  proof-
    interpret tm_cf_discrete α ‹𝔍⦇Arr⦈› A ‹op_cat ℭ› by (rule that)
    from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π 
      where π: "π : A >CF.∐ P : 𝔍⦇Arr⦈ ↦↦Cα ℭ"
      by clarsimp 
    interpret π: is_cat_obj_coprod α ‹𝔍⦇Arr⦈› A ℭ P π by (rule π)
    from π.is_cat_obj_prod_op show ?thesis by auto
  qed
  ultimately obtain u r where u: 
    "u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦Cα op_cat ℭ"
    by 
      (
        rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
          OF 𝔉.is_tm_functor_op, unfolded cat_op_simps
          ]
      )
  interpret u: is_cat_limit α ‹op_cat 𝔍› ‹op_cat ℭ› ‹op_cf 𝔉› r u by (rule u)
  from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
qed

text‹\newpage›

end

Theory CZH_UCAT_Complete

(* Copyright 2021 (C) Mihails Milehins *)

section‹Completeness for categories›
theory CZH_UCAT_Complete
  imports CZH_UCAT_Limit
begin



subsection‹Small-complete category›


subsubsection‹Definition and elementary properties›

locale cat_small_complete = category α ℭ for α ℭ + 
  assumes cat_small_complete: 
    "⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦C.tmα ℭ ⟹ ∃u r. u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"

locale cat_small_cocomplete = category α ℭ for α ℭ + 
  assumes cat_small_cocomplete: 
    "⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦C.tmα ℭ ⟹ ∃u r. u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ"


text‹Rules.›

mk_ide rf cat_small_complete_def[unfolded cat_small_complete_axioms_def]
  |intro cat_small_completeI|
  |dest cat_small_completeD[dest]|
  |elim cat_small_completeE[elim]|

lemma cat_small_completeE'[elim]:
  assumes "cat_small_complete α ℭ" and "𝔉 : 𝔍 ↦↦C.tmα ℭ"
  obtains u r where "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  using assms by auto

mk_ide rf cat_small_cocomplete_def[unfolded cat_small_cocomplete_axioms_def]
  |intro cat_small_cocompleteI|
  |dest cat_small_cocompleteD[dest]|
  |elim cat_small_cocompleteE[elim]|

lemma cat_small_cocompleteE'[elim]:
  assumes "cat_small_cocomplete α ℭ" and "𝔉 : 𝔍 ↦↦C.tmα ℭ"
  obtains u r where "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ"
  using assms by auto


subsubsection‹Duality›

lemma (in cat_small_complete) cat_small_cocomplete_op[cat_op_intros]:
  "cat_small_cocomplete α (op_cat ℭ)"
proof(intro cat_small_cocompleteI)
  fix 𝔉 𝔍 assume "𝔉 : 𝔍 ↦↦C.tmα op_cat ℭ"
  then interpret 𝔉: is_tm_functor α 𝔍 ‹op_cat ℭ› 𝔉 .
  from cat_small_complete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
  obtain u r where u: "u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦Cα ℭ"
    by auto
  then interpret u: is_cat_limit α ‹op_cat 𝔍› ℭ ‹op_cf 𝔉› r u .
  from u.is_cat_colimit_op[unfolded cat_op_simps] show 
    "∃u r. u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα op_cat ℭ"
    by auto
qed (auto intro: cat_cs_intros)

lemmas [cat_op_intros] = cat_small_complete.cat_small_cocomplete_op

lemma (in cat_small_cocomplete) cat_small_complete_op[cat_op_intros]:
  "cat_small_complete α (op_cat ℭ)"
proof(intro cat_small_completeI)
  fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦C.tmα op_cat ℭ"
  then interpret 𝔉: is_tm_functor α 𝔍 ‹op_cat ℭ› 𝔉 .
  from cat_small_cocomplete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
  obtain u r where u: "u : op_cf 𝔉 >CF.colim r : op_cat 𝔍 ↦↦Cα ℭ"
    by auto
  interpret u: is_cat_colimit α ‹op_cat 𝔍› ℭ ‹op_cf 𝔉› r u by (rule u)
  from u.is_cat_limit_op[unfolded cat_op_simps] show 
    "∃u r. u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα op_cat ℭ"
    by auto
qed (auto intro: cat_cs_intros)

lemmas [cat_op_intros] = cat_small_cocomplete.cat_small_complete_op


subsubsection‹A category with equalizers and small products is small-complete›

lemma (in category) cat_small_complete_if_eq_and_obj_prod:
  ―‹See Corollary 2 in Chapter V-2 in \cite{mac_lane_categories_2010}›
  assumes "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔞 ↦ℭ 𝔟; 𝔤 : 𝔞 ↦ℭ 𝔟 ⟧ ⟹
      ∃E ε. ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα ℭ"
    and "⋀A I. tm_cf_discrete α I A ℭ ⟹ ∃P π. π : P <CF.∏ A : I ↦↦Cα ℭ"
  shows "cat_small_complete α ℭ"
proof(intro cat_small_completeI)
  fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦C.tmα ℭ"
  then interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 .
  show "∃u r. u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
    by (rule cat_limit_of_cat_prod_obj_and_cat_equalizer[OF prems assms(1)])
      (auto intro: assms(2))
qed (auto simp: cat_cs_intros)

lemma (in category) cat_small_cocomplete_if_eq_and_obj_prod:
  assumes "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔟 ↦ℭ 𝔞; 𝔤 : 𝔟 ↦ℭ 𝔞 ⟧ ⟹
    ∃E ε. ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
    and "⋀A I. tm_cf_discrete α I A ℭ ⟹ ∃P π. π : A >CF.∐ P : I ↦↦Cα ℭ"
  shows "cat_small_cocomplete α ℭ"
proof-
  have "∃E ε. ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα op_cat ℭ"
    if "𝔣 : 𝔟 ↦ℭ 𝔞" and "𝔤 : 𝔟 ↦ℭ 𝔞" for 𝔞 𝔟 𝔤 𝔣
  proof-
    from assms(1)[OF that] obtain ε E where 
      ε: "ε : (𝔞,𝔟,𝔤,𝔣) >CF.coeq E : ↑↑2C ↦↦Cα ℭ"
      by clarsimp
    interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule ε)
    from ε.is_cat_equalizer_op show ?thesis by auto
  qed
  moreover have "∃P π. π : P <CF.∏ A : I ↦↦Cα op_cat ℭ"
    if "tm_cf_discrete α I A (op_cat ℭ)" for A I
  proof-
    interpret tm_cf_discrete α I A ‹op_cat ℭ› by (rule that)
    from assms(2)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π 
      where π: "π : A >CF.∐ P : I ↦↦Cα ℭ"
      by auto
    interpret π: is_cat_obj_coprod α I A ℭ P π by (rule π)
    from π.is_cat_obj_prod_op show ?thesis by auto
  qed
  ultimately interpret cat_small_complete α ‹op_cat ℭ›
    by 
      (
        rule category.cat_small_complete_if_eq_and_obj_prod[
          OF category_op, unfolded cat_op_simps
          ]
      )
  show ?thesis by (rule cat_small_cocomplete_op[unfolded cat_op_simps])
qed



subsection‹Finite-complete category›

locale cat_finite_complete = category α ℭ for α ℭ + 
  assumes cat_finite_complete: 
    "⋀𝔉 𝔍. ⟦ finite_category α 𝔍; 𝔉 : 𝔍 ↦↦Cα ℭ ⟧ ⟹ 
      ∃u r. u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"

locale cat_finite_cocomplete = category α ℭ for α ℭ + 
  assumes cat_finite_cocomplete: 
    "⋀𝔉 𝔍. ⟦ finite_category α 𝔍; 𝔉 : 𝔍 ↦↦Cα ℭ ⟧ ⟹ 
      ∃u r. u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ"


text‹Rules.›

mk_ide rf cat_finite_complete_def[unfolded cat_finite_complete_axioms_def]
  |intro cat_finite_completeI|
  |dest cat_finite_completeD[dest]|
  |elim cat_finite_completeE[elim]|

lemma cat_finite_completeE'[elim]:
  assumes "cat_finite_complete α ℭ" 
    and "finite_category α 𝔍" 
    and "𝔉 : 𝔍 ↦↦Cα ℭ"
  obtains u r where "u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ"
  using assms by auto

mk_ide rf cat_finite_cocomplete_def[unfolded cat_finite_cocomplete_axioms_def]
  |intro cat_finite_cocompleteI|
  |dest cat_finite_cocompleteD[dest]|
  |elim cat_finite_cocompleteE[elim]|

lemma cat_finite_cocompleteE'[elim]:
  assumes "cat_finite_cocomplete α ℭ" 
    and "finite_category α 𝔍" 
    and "𝔉 : 𝔍 ↦↦Cα ℭ"
  obtains u r where "u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ"
  using assms by auto


text‹Elementary properties.›

sublocale cat_small_complete ⊆ cat_finite_complete
proof(intro cat_finite_completeI)
  fix 𝔉 𝔍 assume prems: "finite_category α 𝔍" "𝔉 : 𝔍 ↦↦Cα ℭ"
  interpret 𝔉: is_functor α 𝔍 ℭ 𝔉 by (rule prems(2))
  from cat_small_complete_axioms show "∃u r. u : r <CF.lim 𝔉 : 𝔍 ↦↦Cα ℭ" 
    by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)

sublocale cat_small_cocomplete ⊆ cat_finite_cocomplete
proof(intro cat_finite_cocompleteI)
  fix 𝔉 𝔍 assume prems: "finite_category α 𝔍" "𝔉 : 𝔍 ↦↦Cα ℭ"
  interpret 𝔉: is_functor α 𝔍 ℭ 𝔉 by (rule prems(2))
  from cat_small_cocomplete_axioms show "∃u r. u : 𝔉 >CF.colim r : 𝔍 ↦↦Cα ℭ" 
    by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)



subsection‹Discrete functor with tiny maps to the category ‹Set››

lemma (in 𝒵) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
  assumes "VLambda I F ∈∘ Vset α"
  shows "tm_cf_discrete α I F (cat_Set α)"
proof(intro tm_cf_discreteI)
  from assms have vrange_F_in_Vset: "ℛ∘ (VLambda I F) ∈∘ Vset α"
    by (auto intro: vrange_in_VsetI)
  show "(λi∈∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈∘ Vset α"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    from assms show "𝒟∘ (λi∈∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈∘ Vset α"
      by (metis vdomain_VLambda vdomain_in_VsetI)
    define Q where
      "Q i =
        (
          if i = 0
          then VPow ((⋃∘i∈∘I. F i) ×∘ (⋃∘i∈∘I. F i)) 
          else set (F ` elts I)
        )" 
      for i :: V
    have "ℛ∘ (λi∈∘I. cat_Set α⦇CId⦈⦇F i⦈) ⊆∘ (∏∘i∈∘ set {0, 1ℕ, 2ℕ}. Q i)"
    proof(intro vsubsetI, unfold cat_Set_components)
      fix y assume "y ∈∘ ℛ∘ (λi∈∘I. VLambda (Vset α) id_Set⦇F i⦈)"
      then obtain i where i: "i ∈∘ I" 
        and y_def: "y = VLambda (Vset α) id_Set⦇F i⦈" 
        by auto
      from i have "F i ∈∘ ℛ∘ (VLambda I F)" by auto
      with vrange_F_in_Vset have "F i ∈∘ Vset α" by auto
      then have y_def: "y = id_Set (F i)" unfolding y_def by auto
      show "y ∈∘ (∏∘i∈∘set {0, 1ℕ, 2ℕ}. Q i)"
        unfolding y_def
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "𝒟∘ (id_Rel (F i)) = set {0, 1ℕ, 2ℕ}"  
          by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
        fix j assume "j ∈∘ set {0, 1ℕ, 2ℕ}"
        then consider ‹j = 0› | ‹j = 1ℕ› | ‹j = 2ℕ› by auto
        then show "id_Rel (F i)⦇j⦈ ∈∘ Q j"
        proof cases
          case 1
          from i show ?thesis
            unfolding 1
            by 
              (
                subst arr_field_simps(1)[symmetric], 
                unfold id_Rel_components Q_def
              )
              force
        next
          case 2
          from i show ?thesis
            unfolding 2
            by 
              (
                subst arr_field_simps(2)[symmetric], 
                unfold id_Rel_components Q_def
              ) 
              auto
        next
          case 3
          from i show ?thesis
            unfolding 3
            by 
              (
                subst arr_field_simps(3)[symmetric], 
                unfold id_Rel_components Q_def
              ) 
              auto
        qed
      qed (auto simp: id_Rel_def cat_Set_cs_intros)
    qed
    moreover have "(∏∘i∈∘ set {0, 1ℕ, 2ℕ}. Q i) ∈∘ Vset α"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1ℕ, 2ℕ} ∈∘ Vset α" unfolding three[symmetric] by simp
      from assms have "VPow ((⋃∘i∈∘I. F i) ×∘ (⋃∘i∈∘I. F i)) ∈∘ Vset α"
        by 
          (
            intro 
              Limit_VPow_in_VsetI 
              Limit_vtimes_in_VsetI 
              Limit_vifunion_in_Vset_if_VLambda_in_VsetI
          )
          auto
      then show "Q i ∈∘ Vset α" if "i ∈∘ set {0, 1ℕ, 2ℕ}" for i
        using that vrange_VLambda
        by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
    qed auto
    ultimately show "ℛ∘ (λi∈∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈∘ Vset α"
      by (meson vsubset_in_VsetI) 
  qed auto
  fix i assume prems: "i ∈∘ I"
  from assms have "ℛ∘ (VLambda I F) ∈∘ Vset α" by (auto simp: vrange_in_VsetI)
  moreover from prems have "F i ∈∘ ℛ∘ (VLambda I F)" by auto
  ultimately show "F i ∈∘ cat_Set α⦇Obj⦈" unfolding cat_Set_components by auto    
qed (cs_concl cs_intro: cat_cs_intros assms)+



subsection‹Product cone for the category ‹Set››


subsubsection‹Definition and elementary properties›

definition ntcf_Set_obj_prod :: "V ⇒ V ⇒ (V ⇒ V) ⇒ V"
  where "ntcf_Set_obj_prod α I F = ntcf_obj_prod_base 
    (cat_Set α) I F (∏∘i∈∘I. F i) (λi. vprojection_arrow I F i)"


text‹Components.›

lemma ntcf_Set_obj_prod_components:
  shows "ntcf_Set_obj_prod α I F⦇NTMap⦈ =
    (λi∈∘:C I⦇Obj⦈. vprojection_arrow I F i)"
    and "ntcf_Set_obj_prod α I F⦇NTDom⦈ =
    cf_const (:C I) (cat_Set α) (∏∘i∈∘I. F i)"
    and "ntcf_Set_obj_prod α I F⦇NTCod⦈ = :→: I F (cat_Set α)"
    and "ntcf_Set_obj_prod α I F⦇NTDGDom⦈ = :C I"
    and "ntcf_Set_obj_prod α I F⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all


subsubsection‹Natural transformation map›

mk_VLambda ntcf_Set_obj_prod_components(1)
  |vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]|


subsubsection‹Product cone for the category ‹Set› is a universal cone›

lemma (in 𝒵) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
  ―‹See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.›
  assumes "VLambda I F ∈∘ Vset α"
  shows "ntcf_Set_obj_prod α I F : (∏∘i∈∘I. F i) <CF.∏ F : I ↦↦Cα cat_Set α"
proof(intro is_cat_obj_prodI is_cat_limitI')

  interpret Set: tm_cf_discrete α I F ‹cat_Set α› 
    by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])

  let ?F = ‹ntcf_Set_obj_prod α I F›

  show "cf_discrete α I F (cat_Set α)"
    by (auto simp: cat_small_discrete_cs_intros)
  show F_is_cat_cone: "?F :
    (∏∘i∈∘I. F i) <CF.cone :→: I F (cat_Set α) : :C I ↦↦Cα cat_Set α"
      unfolding ntcf_Set_obj_prod_def
  proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
    show "(∏∘i∈∘I. F i) ∈∘ cat_Set α⦇Obj⦈"
      unfolding cat_Set_components
      by 
        (
          intro 
            Limit_vproduct_in_Vset_if_VLambda_in_VsetI 
            Set.tm_cf_discrete_ObjMap_in_Vset
        ) 
        auto
  qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)

  interpret F: is_cat_cone 
    α ‹∏∘i∈∘I. F i› ‹:C I› ‹cat_Set α› ‹:→: I F (cat_Set α)› ‹?F›
    by (rule F_is_cat_cone)

  fix π' P' assume prems:
    "π' : P' <CF.cone :→: I F (cat_Set α) : :C I ↦↦Cα cat_Set α"

  let ?π'i = ‹λi. π'⦇NTMap⦈⦇i⦈›
  let ?up' = ‹cat_Set_obj_prod_up I F P' ?π'i›

  interpret π': is_cat_cone α P' ‹:C I› ‹cat_Set α› ‹:→: I F (cat_Set α)› π'
    by (rule prems(1))

  show "∃!f'.
    f' : P' ↦cat_Set α (∏∘i∈∘I. F i) ∧
    π' = ?F ∙NTCF ntcf_const (:C I) (cat_Set α) f'"
  proof(intro ex1I conjI; (elim conjE)?)
    show up': "?up' : P' ↦cat_Set α (∏∘i∈∘I. F i)" 
    proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
      show "P' ∈∘ Vset α" by (auto intro: cat_cs_intros cat_lim_cs_intros)
      fix i assume "i ∈∘ I"
      then show "π'⦇NTMap⦈⦇i⦈ : P' ↦cat_Set α F i"
        by 
          (
            cs_concl 
              cs_simp: 
                the_cat_discrete_components(1) 
                cat_cs_simps cat_discrete_cs_simps 
              cs_intro: cat_cs_intros
          )
    qed (rule assms)

    then have P': "P' ∈∘ Vset α" 
      by (auto intro: cat_cs_intros cat_lim_cs_intros)

    have π'i_i: "?π'i i : P' ↦cat_Set α F i" if "i ∈∘ I" for i
      using 
        π'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
        that
      by 
        (
          cs_prems cs_simp:
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
        )
    from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) π'i_i] have π'i: 
      "cat_Set_obj_prod_up I F P' ?π'i : P' ↦cat_Set α (∏∘i∈∘I. F i)". 

    show "π' = ?F ∙NTCF ntcf_const (:C I) (cat_Set α) ?up'"
    proof(rule ntcf_eqI, rule π'.is_ntcf_axioms)

      from F_is_cat_cone π'i show 
        "?F ∙NTCF ntcf_const (:C I) (cat_Set α) ?up' :
          cf_const (:C I) (cat_Set α) P' ↦CF :→: I F (cat_Set α) : 
          :C I ↦↦Cα cat_Set α"
        by (cs_concl cs_intro: cat_cs_intros)

      have dom_lhs: "𝒟∘ (π'⦇NTMap⦈) = :C I⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      from F_is_cat_cone π'i have dom_rhs: 
        "𝒟∘ ((?F ∙NTCF ntcf_const (:C I) (cat_Set α) ?up')⦇NTMap⦈) = :C I⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      show "π'⦇NTMap⦈ = (?F ∙NTCF ntcf_const (:C I) (cat_Set α) ?up')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix i assume prems': "i ∈∘ :C I⦇Obj⦈"
        then have i: "i ∈∘ I" unfolding the_cat_discrete_components by simp
        have [cat_cs_simps]: 
          "vprojection_arrow I F i ∘Acat_Set α ?up' = π'⦇NTMap⦈⦇i⦈"
          by 
            (
              rule pdg_dghm_comp_dghm_proj_dghm_up[
                OF P' assms π'i_i i, symmetric
                ]
            ) 
            auto
        from π'i prems' show "π'⦇NTMap⦈⦇i⦈ =
          (?F ∙NTCF ntcf_const (:C I) (cat_Set α) ?up')⦇NTMap⦈⦇i⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
            )
      qed (auto simp: cat_cs_intros)

    qed simp_all

    fix f' assume prems:
      "f' : P' ↦cat_Set α (∏∘i∈∘I. F i)"
      "π' = ?F ∙NTCF ntcf_const (:C I) (cat_Set α) f'"
    from prems(2) have π'_eq_F_f': "π'⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈ = 
      (?F ∙NTCF ntcf_const (:C I) (cat_Set α) f')⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈"
      if "i ∈∘ I" and "a ∈∘ P'" for i a
      by simp
    have [cat_Set_cs_simps]: "π'⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈ = f'⦇ArrVal⦈⦇a⦈⦇i⦈"
      if "i ∈∘ I" and "a ∈∘ P'" for i a
      using 
        π'_eq_F_f'[OF that] 
        assms prems that 
        vprojection_arrow_is_arr[OF that(1) assms]
      by 
        (
          cs_prems
            cs_simp: 
              cat_Set_cs_simps 
              cat_cs_simps 
              vprojection_arrow_app 
              the_cat_discrete_components(1) 
            cs_intro: cat_Set_cs_intros cat_cs_intros
        )

    note f' = cat_Set_is_arrD[OF prems(1)]
    note up' = cat_Set_is_arrD[OF up']

    interpret f': arr_Set α f' by (rule f'(1))
    interpret u': arr_Set α ‹(cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈)))› 
      by (rule up'(1))

    show "f' = ?up'"
    proof(rule arr_Set_eqI[of α])
      have dom_lhs: "𝒟∘ (f'⦇ArrVal⦈) = P'" 
        by (simp add: cat_Set_cs_simps cat_cs_simps f')
      have dom_rhs: 
        "𝒟∘ (cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈) = P'"
        by (simp add: cat_Set_cs_simps cat_cs_simps up')
      show "f'⦇ArrVal⦈ = cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems': "a ∈∘ P'"
        from prems(1) prems' have "f'⦇ArrVal⦈⦇a⦈ ∈∘ (∏∘i∈∘I. F i)"
          by (cs_concl cs_intro: cat_Set_cs_intros)
        note f'a = vproductD[OF this]
        from prems' have dom_rhs: 
          "𝒟∘ (cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈) = I"
          by (cs_concl cs_simp: cat_Set_cs_simps)
        show "f'⦇ArrVal⦈⦇a⦈ =
          cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈"
        proof(rule vsv_eqI, unfold f'a dom_rhs)
          fix i assume "i ∈∘ I"
          with prems' show "f'⦇ArrVal⦈⦇a⦈⦇i⦈ =
            cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈⦇i⦈"
            by (cs_concl cs_simp: cat_Set_cs_simps)
        qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
      qed auto
    qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))

  qed

qed



subsection‹Equalizer for the category ‹Set››


subsubsection‹Definition and elementary properties›

abbreviation ntcf_Set_equalizer_map :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Set_equalizer_map α a g f i ≡
    (
      i = 𝔞PL ?
        incl_Set (vequalizer a g f) a :
        g ∘Acat_Set α incl_Set (vequalizer a g f) a
    )"

definition ntcf_Set_equalizer :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Set_equalizer α a b g f = ntcf_equalizer_base
    (cat_Set α) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map α a g f)"


text‹Components.›

context
  fixes a g f α :: V
begin

lemmas ntcf_Set_equalizer_components = 
  ntcf_equalizer_base_components[
    where ℭ=‹cat_Set α› 
      and e=‹ntcf_Set_equalizer_map α a g f›
      and E=‹vequalizer a g f›
      and 𝔞=a and 𝔤=g and 𝔣=f,
      folded ntcf_Set_equalizer_def
      ]

end


subsubsection‹Natural transformation map›

mk_VLambda ntcf_Set_equalizer_components(1)
  |vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]|
  |vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]|
  |app ntcf_Set_equalizer_NTMap_app|

lemma ntcf_Set_equalizer_2_NTMap_app_𝔞[cat_Set_cs_simps]:
  assumes "x = 𝔞PL"
  shows 
    "ntcf_Set_equalizer α a b g f⦇NTMap⦈⦇x⦈ =
      incl_Set (vequalizer a g f) a"
  unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components 
  by simp

lemma ntcf_Set_equalizer_2_NTMap_app_𝔟[cat_Set_cs_simps]:
  assumes "x = 𝔟PL"
  shows 
    "ntcf_Set_equalizer α a b g f⦇NTMap⦈⦇x⦈ =
      g ∘Acat_Set α incl_Set (vequalizer a g f) a"
  unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
  using cat_PL_ineq
  by auto


subsubsection‹Equalizer for the category ‹Set› is an equalizer›

lemma (in 𝒵) ntcf_Set_equalizer_2_is_cat_equalizer_2:
  assumes "𝔤 : 𝔞 ↦cat_Set α 𝔟" and "𝔣 : 𝔞 ↦cat_Set α 𝔟" 
  shows "ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 :
    vequalizer 𝔞 𝔤 𝔣 <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα cat_Set α"
proof(intro is_cat_equalizerI is_cat_equalizerI is_cat_limitI')
  
  let ?II_II = ‹↑↑→↑↑ (cat_Set α) 𝔞PL 𝔟PL 𝔤PL 𝔣PL 𝔞 𝔟 𝔤 𝔣›
    and ?II = ‹↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL›

  note 𝔤 = cat_Set_is_arrD[OF assms(1)]
  interpret 𝔤: arr_Set α 𝔤 
    rewrites "𝔤⦇ArrDom⦈ = 𝔞" and "𝔤⦇ArrCod⦈ = 𝔟"
    by (rule 𝔤(1)) (simp_all add: 𝔤)
  note 𝔣 = cat_Set_is_arrD[OF assms(2)]
  interpret 𝔣: arr_Set α 𝔣 
    rewrites "𝔣⦇ArrDom⦈ = 𝔞" and "𝔣⦇ArrCod⦈ = 𝔟"
    by (rule 𝔣(1)) (simp_all add: 𝔣)

  note [cat_Set_cs_intros] = 𝔤.arr_Set_ArrDom_in_Vset 𝔣.arr_Set_ArrCod_in_Vset
  
  let ?incl = ‹incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞›

  show 𝔞𝔟𝔤𝔣_is_cat_cone: "ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 :
    vequalizer 𝔞 𝔤 𝔣 <CF.cone ?II_II : ?II ↦↦Cα cat_Set α"
    unfolding ntcf_Set_equalizer_def
  proof
    (
      intro 
        category.cat_ntcf_equalizer_base_is_cat_cone 
        category.cat_cf_parallel_cat_equalizer
    )
    from assms show 
      "(𝔟PL = 𝔞PL ? ?incl : 𝔤 ∘Acat_Set α ?incl) :
        vequalizer 𝔞 𝔤 𝔣 ↦cat_Set α 𝔟"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps 
            cs_intro: 
              V_cs_intros cat_Set_cs_intros cat_cs_intros 
              cat_PL_ineq[symmetric] 
        )
    show 
      "(𝔟PL = 𝔞PL ? ?incl : 𝔤 ∘Acat_Set α ?incl) =
        𝔤 ∘Acat_Set α (𝔞PL = 𝔞PL ? ?incl : 𝔤 ∘Acat_Set α ?incl)"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps 
            cs_intro: 
              V_cs_intros cat_Set_cs_intros cat_cs_intros 
              cat_PL_ineq[symmetric] 
        )
    from assms show 
      "(𝔟PL = 𝔞PL ? ?incl : 𝔤 ∘Acat_Set α ?incl) =
        𝔣 ∘Acat_Set α (𝔞PL = 𝔞PL ? ?incl : 𝔤 ∘Acat_Set α ?incl)"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps cat_Set_incl_Set_commute 
            cs_intro: V_cs_intros cat_PL_ineq[symmetric]
        )
  qed 
    (
      cs_concl 
        cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms 
        cs_simp: V_cs_simps cat_cs_simps
    )+

  interpret 𝔞𝔟𝔤𝔣: is_cat_cone 
    α ‹vequalizer 𝔞 𝔤 𝔣› ?II ‹cat_Set α› ?II_II ‹ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣›
    by (rule 𝔞𝔟𝔤𝔣_is_cat_cone)

  show "∃!f'.
    f' : r' ↦cat_Set α vequalizer 𝔞 𝔤 𝔣 ∧ 
    u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) f'"
    if "u' : r' <CF.cone ?II_II : ?II ↦↦Cα cat_Set α" for u' r'
  proof-
    
    interpret u': is_cat_cone α r' ?II ‹cat_Set α› ?II_II u' by (rule that(1))

    have "𝔞PL ∈∘ ↑↑C 𝔞PL 𝔟PL 𝔤PL 𝔣PL⦇Obj⦈" 
      unfolding the_cat_parallel_components(1) by simp
    from 
      u'.ntcf_NTMap_is_arr[OF this] 
      𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms] 
    have u'_𝔞PL_is_arr: "u'⦇NTMap⦈⦇𝔞PL⦈ : r' ↦cat_Set α 𝔞"
      by (cs_prems_atom_step cat_cs_simps) 
        (
          cs_prems 
            cs_simp: cat_parallel_cs_simps 
            cs_intro: 
              cat_parallel_cs_intros 
              cat_cs_intros
              category.cat_cf_parallel_cat_equalizer
        )
    note u'_𝔞PL = cat_Set_is_arrD[OF u'_𝔞PL_is_arr]
    interpret u'_𝔞PL: arr_Set α ‹u'⦇NTMap⦈⦇𝔞PL⦈› by (rule u'_𝔞PL(1))

    have "𝔟PL ∈∘ ?II⦇Obj⦈" 
      by (cs_concl cs_intro: cat_parallel_cs_intros)

    from 
      u'.ntcf_NTMap_is_arr[OF this] 
      𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
    have "u'⦇NTMap⦈⦇𝔟PL⦈ : r' ↦cat_Set α 𝔟"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_parallel_cs_simps 
            cs_intro: cat_parallel_cs_intros
        )

    note u'_𝔤u' = cat_cone_cf_par_eps_NTMap_app(1)[OF that(1) assms]
    
    define q where "q = [u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈, r', vequalizer 𝔞 𝔤 𝔣]∘"

    have q_components[cat_Set_cs_simps]:  
      "q⦇ArrVal⦈ = u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈" 
      "q⦇ArrDom⦈ = r'" 
      "q⦇ArrCod⦈ = vequalizer 𝔞 𝔤 𝔣"
      unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)

    from cat_cone_cf_par_eps_NTMap_app[OF that(1) assms] have 𝔤u'_eq_𝔣u':
      "(𝔤 ∘Acat_Set α u'⦇NTMap⦈⦇𝔞PL⦈)⦇ArrVal⦈⦇x⦈ =
        (𝔣 ∘Acat_Set α u'⦇NTMap⦈⦇𝔞PL⦈)⦇ArrVal⦈⦇x⦈"
      for x 
      by simp

    show ?thesis
    proof(intro ex1I conjI; (elim conjE)?)

      have u'_NTMap_vrange: "ℛ∘ (u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈) ⊆∘ vequalizer 𝔞 𝔤 𝔣"
      proof(rule vsubsetI)
        fix y assume prems: "y ∈∘ ℛ∘ (u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈)"
        then obtain x where x: "x ∈∘ 𝒟∘ (u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈)" 
          and y_def: "y = u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈⦇x⦈"
          by (blast dest: u'_𝔞PL.ArrVal.vrange_atD)
        have x: "x ∈∘ r'" 
          by (use x u'_𝔞PL_is_arr in ‹cs_prems cs_simp: cat_cs_simps›)          
        from 𝔤u'_eq_𝔣u'[of x] assms x u'_𝔞PL_is_arr have [simp]: 
          "𝔤⦇ArrVal⦈⦇u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈⦇x⦈⦈ =
            𝔣⦇ArrVal⦈⦇u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈⦇x⦈⦈"
          by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from prems u'_𝔞PL.arr_Set_ArrVal_vrange[unfolded u'_𝔞PL] show 
          "y ∈∘ vequalizer 𝔞 𝔤 𝔣"
          by (intro vequalizerI, unfold y_def) auto
      qed

      show q_is_arr: "q : r' ↦cat_Set α vequalizer 𝔞 𝔤 𝔣" 
      proof(intro cat_Set_is_arrI arr_SetI)
        show "q⦇ArrCod⦈ ∈∘ Vset α" 
          by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
      qed 
        (
          auto 
            simp: 
              cat_Set_cs_simps nat_omega_simps 
              u'_𝔞PL 
              q_def 
              u'_NTMap_vrange
              𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_in_Obj_in_Vset
            intro: cat_cs_intros cat_lim_cs_intros
        )  

      from q_is_arr have 𝔞_q:  
        "incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q : 
          r' ↦cat_Set α 𝔞"
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
          )
      interpret arr_Set α ‹incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q›
        using 𝔞_q by (auto dest: cat_Set_is_arrD)

      show "u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q"
      proof(rule ntcf_eqI)
        from q_is_arr show 
          "ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q :
            cf_const ?II (cat_Set α) r' ↦CF 
            ?II_II : ?II ↦↦Cα cat_Set α"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        have dom_lhs: "𝒟∘ (u'⦇NTMap⦈) = ?II⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        from q_is_arr have dom_rhs:
          "𝒟∘ 
            (
              (ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF 
              ntcf_const ?II (cat_Set α) q
            )⦇NTMap⦈) =  ?II⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ =
          (
            ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q
          )⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          show "vsv ((
            ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q
            )⦇NTMap⦈)"
            by (cs_concl cs_intro: cat_cs_intros)
          fix a assume prems: "a ∈∘ ?II⦇Obj⦈"
          have [symmetric, cat_Set_cs_simps]: 
            "u'⦇NTMap⦈⦇𝔞PL⦈ = incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q"
          proof(rule arr_Set_eqI[of α])
            from u'_𝔞PL_is_arr have dom_lhs: "𝒟∘ (u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈) = r'"
              by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
            from 𝔞_q have dom_rhs: 
              "𝒟∘ ((incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q)⦇ArrVal⦈) = r'"
              by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
            show "u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈ =
              (incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q)⦇ArrVal⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix a assume prems: "a ∈∘ r'"
              with u'_NTMap_vrange dom_lhs u'_𝔞PL.ArrVal.vsv_vimageI2 have 
                "u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈⦇a⦈ ∈∘ vequalizer 𝔞 𝔤 𝔣"
                by blast
              with prems q_is_arr u'_𝔞PL_is_arr show 
                "u'⦇NTMap⦈⦇𝔞PL⦈⦇ArrVal⦈⦇a⦈ =
                  (incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α q)⦇ArrVal⦈⦇a⦈"
                by 
                  (
                    cs_concl 
                      cs_simp: cat_Set_cs_simps cat_cs_simps 
                      cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
                  )
            qed auto
          qed 
            (
              use u'_𝔞PL 𝔞_q in ‹
                cs_concl cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
                ›
            )+
          from q_is_arr have u'_NTMap_app_I: "u'⦇NTMap⦈⦇𝔞PL⦈ =
            (
              ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q
            )⦇NTMap⦈⦇𝔞PL⦈"
            by 
              (
                cs_concl 
                  cs_intro: cat_cs_intros cat_parallel_cs_intros 
                  cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
              )
          from q_is_arr assms have u'_NTMap_app_sI: "u'⦇NTMap⦈⦇𝔟PL⦈ =
            (
              ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) q
            )⦇NTMap⦈⦇𝔟PL⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_Set_cs_simps cat_cs_simps u'_𝔤u' 
                  cs_intro: 
                    V_cs_intros 
                    cat_cs_intros 
                    cat_Set_cs_intros 
                    cat_parallel_cs_intros
              )
          from prems consider ‹a = 𝔞PL› | ‹a = 𝔟PL› 
            by (elim the_cat_parallel_ObjE)
          then show 
            "u'⦇NTMap⦈⦇a⦈ =
              (
                ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF
                ntcf_const ?II (cat_Set α) q
              )⦇NTMap⦈⦇a⦈"
            by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
        qed auto
      qed (simp_all add: u'.is_ntcf_axioms)
        
      fix f' assume prems:
        "f' : r' ↦cat_Set α vequalizer 𝔞 𝔤 𝔣"
        "u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF ntcf_const ?II (cat_Set α) f'"
      from prems(2) have u'_NTMap_app: 
        "u'⦇NTMap⦈⦇x⦈ =
          (ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙NTCF
          ntcf_const ?II (cat_Set α) f')⦇NTMap⦈⦇x⦈"
        for x
        by simp
      have u'_f': 
        "u'⦇NTMap⦈⦇𝔞PL⦈ = incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘Acat_Set α f'"
        using u'_NTMap_app[of 𝔞PL] prems(1)
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
          (cs_prems cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros)

      note f' = cat_Set_is_arrD[OF prems(1)]
      note q = cat_Set_is_arrD[OF q_is_arr]

      interpret f': arr_Set α f' using prems(1) by (auto dest: cat_Set_is_arrD)
      interpret q: arr_Set α q using q by (auto dest: cat_Set_is_arrD)

      show "f' = q"
      proof(rule arr_Set_eqI[of α])
        have dom_lhs: "𝒟∘ (f'⦇ArrVal⦈) = r'" by (simp add: cat_Set_cs_simps f')
        from q_is_arr have dom_rhs: "𝒟∘ (q⦇ArrVal⦈) = r'" 
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros)
        show "f'⦇ArrVal⦈ = q⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix i assume "i ∈∘ r'"
          with prems(1) show "f'⦇ArrVal⦈⦇i⦈ = q⦇ArrVal⦈⦇i⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_Set_cs_simps cat_cs_simps q_components u'_f'
                  cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
              )
        qed auto
      qed 
        (
          use prems(1) q_is_arr in ‹
            cs_concl cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
            ›
        )+
    qed
  qed

qed (auto intro: assms)



subsection‹The category ‹Set› is small-complete›

lemma (in 𝒵) cat_small_complete_cat_Set: "cat_small_complete α (cat_Set α)"
  ―‹This lemma appears as a remark on page 113 in
\cite{mac_lane_categories_2010}.›
proof(rule category.cat_small_complete_if_eq_and_obj_prod)
  show "∃E ε. ε : E <CF.eq (𝔞,𝔟,𝔤,𝔣) : ↑↑2C ↦↦Cα cat_Set α"
    if "𝔣 : 𝔞 ↦cat_Set α 𝔟" and "𝔤 : 𝔞 ↦cat_Set α 𝔟" for 𝔞 𝔟 𝔤 𝔣
    using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
  show "∃P π. π : P <CF.∏ A : I ↦↦Cα cat_Set α"
    if "tm_cf_discrete α I A (cat_Set α)" for A I
  proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
    interpret tm_cf_discrete α I A ‹cat_Set α› by (rule that)
    show "VLambda I A ∈∘ Vset α" by (rule tm_cf_discrete_ObjMap_in_Vset)
  qed
qed (rule category_cat_Set)

text‹\newpage›

end

Theory CZH_UCAT_Adjoints

(* Copyright 2021 (C) Mihails Milehins *)

section‹Adjoints›
theory CZH_UCAT_Adjoints
  imports 
    CZH_UCAT_Universal
    CZH_Elementary_Categories.CZH_ECAT_Yoneda
begin



subsection‹Background›

named_theorems adj_cs_simps
named_theorems adj_cs_intros
named_theorems adj_field_simps

definition AdjLeft :: V where [adj_field_simps]: "AdjLeft = 0"
definition AdjRight :: V where [adj_field_simps]: "AdjRight = 1ℕ"
definition AdjNT :: V where [adj_field_simps]: "AdjNT = 2ℕ"



subsection‹Definition and elementary properties›


text‹
See subsection 2.1 in \cite{bodo_categories_1970} or Chapter IV-1 in
\cite{mac_lane_categories_2010}.
›

locale is_cf_adjunction =
  𝒵 α +
  vfsequence Φ +
  L: category α ℭ +
  R: category α 𝔇 +
  LR: is_functor α ℭ 𝔇 𝔉 +
  RL: is_functor α 𝔇 ℭ 𝔊 +
  NT: is_iso_ntcf 
    α 
    ‹op_cat ℭ ×C 𝔇› 
    ‹cat_Set α› 
    ‹HomO.Cα𝔇(𝔉-,-)› 
    ‹HomO.Cαℭ(-,𝔊-)› 
    ‹Φ⦇AdjNT⦈›
    for α ℭ 𝔇 𝔉 𝔊 Φ +
  assumes cf_adj_length[adj_cs_simps]: "vcard Φ = 3ℕ"
    and cf_adj_AdjLeft[adj_cs_simps]: "Φ⦇AdjLeft⦈ = 𝔉"
    and cf_adj_AdjRight[adj_cs_simps]: "Φ⦇AdjRight⦈ = 𝔊"

syntax "_is_cf_adjunction" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ : _ ⇌CF _ : _ ⇌⇌Cı _)› [51, 51, 51, 51, 51] 51)
translations "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" ⇌ 
  "CONST is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ"

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adj_length
  is_cf_adjunction.cf_adj_AdjLeft
  is_cf_adjunction.cf_adj_AdjRight


text‹Components.›

lemma cf_adjunction_components[adj_cs_simps]:
  "[𝔉, 𝔊, φ]∘⦇AdjLeft⦈ = 𝔉"
  "[𝔉, 𝔊, φ]∘⦇AdjRight⦈ = 𝔊"
  "[𝔉, 𝔊, φ]∘⦇AdjNT⦈ = φ"
  unfolding AdjLeft_def AdjRight_def AdjNT_def 
  by (simp_all add: nat_omega_simps)


text‹Rules.›

lemma (in is_cf_adjunction) is_cf_adjunction_axioms'[adj_cs_intros]:
  assumes "α' = α" and "ℭ' = ℭ" and "𝔇' = 𝔇" and "𝔉' = 𝔉" and "𝔊' = 𝔊"
  shows "Φ : 𝔉' ⇌CF 𝔊' : ℭ' ⇌⇌Cα' 𝔇'"  
  unfolding assms by (rule is_cf_adjunction_axioms)

lemmas (in is_cf_adjunction) [adj_cs_intros] = is_cf_adjunction_axioms

mk_ide rf is_cf_adjunction_def[unfolded is_cf_adjunction_axioms_def]
  |intro is_cf_adjunctionI|
  |dest is_cf_adjunctionD[dest]|
  |elim is_cf_adjunctionE[elim]|

lemmas [adj_cs_intros] = is_cf_adjunctionD(3-6)

lemma (in is_cf_adjunction) cf_adj_is_iso_ntcf':
  assumes "𝔉' = HomO.Cα𝔇(𝔉-,-)"
    and "𝔊' = HomO.Cαℭ(-,𝔊-)"
    and "𝔄' = op_cat ℭ ×C 𝔇"
    and "𝔅' = cat_Set α"
  shows "Φ⦇AdjNT⦈ : 𝔉' ↦CF.iso 𝔊' : 𝔄' ↦↦Cα 𝔅'"
  unfolding assms by (auto intro: cat_cs_intros)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adj_is_iso_ntcf'

lemma cf_adj_eqI:
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "Φ' : 𝔉' ⇌CF 𝔊' : ℭ' ⇌⇌Cα 𝔇'"
    and "ℭ = ℭ'"
    and "𝔇 = 𝔇'"
    and "𝔉 = 𝔉'"
    and "𝔊 = 𝔊'"
    and "Φ⦇AdjNT⦈ = Φ'⦇AdjNT⦈"
  shows "Φ = Φ'"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Φ': is_cf_adjunction α ℭ' 𝔇' 𝔉' 𝔊' Φ' by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "𝒟∘ Φ = 3ℕ" by (cs_concl cs_simp: V_cs_simps adj_cs_simps)
    show "𝒟∘ Φ = 𝒟∘ Φ'" by (cs_concl cs_simp: V_cs_simps adj_cs_simps dom)
    from assms(4-7) have sup: 
      "Φ⦇AdjLeft⦈ = Φ'⦇AdjLeft⦈" 
      "Φ⦇AdjRight⦈ = Φ'⦇AdjRight⦈" 
      "Φ⦇AdjNT⦈ = Φ'⦇AdjNT⦈"  
      by (simp_all add: adj_cs_simps)
    show "a ∈∘ 𝒟∘ Φ ⟹ Φ⦇a⦈ = Φ'⦇a⦈" for a 
      by (unfold dom, elim_in_numeral, insert sup) 
        (auto simp: adj_field_simps)
  qed (auto simp: Φ.L.vsv_axioms Φ'.vsv_axioms)
qed



subsection‹Opposite adjunction›


subsubsection‹Definition and elementary properties›


text‹
The following definition has the desired properties of the operation
of taking an opposite of an adjunction but helps to avoid dealing
with isomorphisms that arise in certain applications if the conventional
operation of taking the opposite is used instead.
›

abbreviation op_cf_adj_nt :: "V ⇒ V ⇒ V ⇒ V"
  where "op_cf_adj_nt ℭ 𝔇 φ ≡ inv_ntcf (bnt_flip (op_cat ℭ) 𝔇 φ)"

definition op_cf_adj :: "V ⇒ V"
  where "op_cf_adj Φ =
    [
      op_cf (Φ⦇AdjRight⦈),
      op_cf (Φ⦇AdjLeft⦈),
      op_cf_adj_nt (Φ⦇AdjLeft⦈⦇HomDom⦈) (Φ⦇AdjLeft⦈⦇HomCod⦈) (Φ⦇AdjNT⦈)
    ]∘"

lemma op_cf_adj_components:
  shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf (Φ⦇AdjRight⦈)"
    and "op_cf_adj Φ⦇AdjRight⦈ = op_cf (Φ⦇AdjLeft⦈)"
    and "op_cf_adj Φ⦇AdjNT⦈ = 
      op_cf_adj_nt (Φ⦇AdjLeft⦈⦇HomDom⦈) (Φ⦇AdjLeft⦈⦇HomCod⦈) (Φ⦇AdjNT⦈)"
  unfolding op_cf_adj_def adj_field_simps by (simp_all add: nat_omega_simps)

lemma (in is_cf_adjunction) op_cf_adj_components:
  shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf 𝔊"
    and "op_cf_adj Φ⦇AdjRight⦈ = op_cf 𝔉"
    and "op_cf_adj Φ⦇AdjNT⦈ = inv_ntcf (bnt_flip (op_cat ℭ) 𝔇 (Φ⦇AdjNT⦈))"
  unfolding op_cf_adj_components by (simp_all add: cat_cs_simps adj_cs_simps)

lemmas [cat_op_simps] = is_cf_adjunction.op_cf_adj_components


text‹The opposite adjunction is an adjunction.›

lemma (in is_cf_adjunction) is_cf_adjunction_op:
  ―‹See comments in subsection 2.1 in \cite{bodo_categories_1970}.›
  "op_cf_adj Φ : op_cf 𝔊 ⇌CF op_cf 𝔉 : op_cat 𝔇 ⇌⇌Cα op_cat ℭ"
proof(intro is_cf_adjunctionI, unfold cat_op_simps, unfold op_cf_adj_components)
  show "vfsequence (op_cf_adj Φ)" unfolding op_cf_adj_def by simp
  show "vcard (op_cf_adj Φ) = 3ℕ"
    unfolding op_cf_adj_def by (simp add: nat_omega_simps)
  note adj = is_cf_adjunctionD[OF is_cf_adjunction_axioms]
  from adj have f_φ: "bnt_flip (op_cat ℭ) 𝔇 (Φ⦇AdjNT⦈) :
    HomO.Cαop_cat 𝔇(-,op_cf 𝔉-) ↦CF.iso HomO.Cαop_cat ℭ(op_cf 𝔊-,-) :
    𝔇 ×C op_cat ℭ ↦↦Cα cat_Set α"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
  show "op_cf_adj_nt ℭ 𝔇 (Φ⦇AdjNT⦈) :
    HomO.Cαop_cat ℭ(op_cf 𝔊-,-) ↦CF.iso HomO.Cαop_cat 𝔇(-,op_cf 𝔉-) :
    𝔇 ×C op_cat ℭ ↦↦Cα cat_Set α"
    by (rule CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF f_φ])
qed (auto intro: cat_cs_intros cat_op_intros)

lemmas is_cf_adjunction_op = 
  is_cf_adjunction.is_cf_adjunction_op

lemma (in is_cf_adjunction) is_cf_adjunction_op'[cat_op_intros]:
  assumes "𝔊' = op_cf 𝔊"
    and "𝔉' = op_cf 𝔉"
    and "𝔇' = op_cat 𝔇"
    and "ℭ' = op_cat ℭ"
  shows "op_cf_adj Φ : 𝔊' ⇌CF 𝔉' : 𝔇' ⇌⇌Cα ℭ'"
  unfolding assms by (rule is_cf_adjunction_op)

lemmas [cat_op_intros] = is_cf_adjunction.is_cf_adjunction_op'


text‹The operation of taking the opposite adjunction is an involution.›

lemma (in is_cf_adjunction) cf_adjunction_op_cf_adj_op_cf_adj[cat_op_simps]:
  "op_cf_adj (op_cf_adj Φ) = Φ"
proof(rule cf_adj_eqI)
  show Φ': "op_cf_adj (op_cf_adj Φ) : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
  proof(intro is_cf_adjunctionI)
    show "vfsequence (op_cf_adj (op_cf_adj Φ))" unfolding op_cf_adj_def by simp
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ : 
      HomO.Cα𝔇(𝔉-,-) ↦CF.iso HomO.Cαℭ(-,𝔊-) : 
      op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      by
        (
          cs_concl cs_ist_simple
            cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
            cs_simp: cat_cs_simps cat_op_simps
        )
    show "vcard (op_cf_adj (op_cf_adj Φ)) = 3ℕ"
      unfolding op_cf_adj_def by (simp add: nat_omega_simps)
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjLeft⦈ = 𝔉"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjRight⦈ = 𝔊"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
  qed (auto intro: cat_cs_intros)
  interpret Φ': is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹op_cf_adj (op_cf_adj Φ)› 
    by (rule Φ')
  show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ = Φ⦇AdjNT⦈"
  proof(rule ntcf_eqI)
    show op_op_Φ:
      "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ :
        HomO.Cα𝔇(𝔉-,-) ↦CF HomO.Cαℭ(-,𝔊-) :
        op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      by (rule Φ'.NT.is_ntcf_axioms)
    show Φ: "Φ⦇AdjNT⦈ :
      HomO.Cα𝔇(𝔉-,-) ↦CF HomO.Cαℭ(-,𝔊-) : 
      op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      by (rule NT.is_ntcf_axioms)
    from op_op_Φ have dom_lhs:
      "𝒟∘ (op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈) = (op_cat ℭ ×C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈ = Φ⦇AdjNT⦈⦇NTMap⦈"
    proof(rule vsv_eqI, unfold NT.ntcf_NTMap_vdomain dom_lhs)
      fix cd assume prems: "cd ∈∘ (op_cat ℭ ×C 𝔇)⦇Obj⦈"
      then obtain c d 
        where cd_def: "cd = [c, d]∘"
          and c: "c ∈∘ op_cat ℭ⦇Obj⦈"
          and d: "d ∈∘ 𝔇⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF L.category_op R.category_axioms prems])
      from is_cf_adjunction_axioms c d L.category_axioms R.category_axioms Φ 
      show 
        "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈⦇cd⦈ = Φ⦇AdjNT⦈⦇NTMap⦈⦇cd⦈"
        unfolding cd_def cat_op_simps
        by 
          (
            cs_concl
              cs_intro: 
                cat_arrow_cs_intros 
                ntcf_cs_intros 
                adj_cs_intros 
                cat_op_intros 
                cat_cs_intros 
                cat_prod_cs_intros 
             cs_simp: cat_cs_simps cat_op_simps
         )
    qed (auto intro: inv_ntcf_NTMap_vsv)
  qed simp_all
qed (auto intro: adj_cs_intros)

lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj



subsubsection‹Alternative form of the naturality condition›


text‹
The lemmas in this subsection are based on the comments on page 81 in 
\cite{mac_lane_categories_2010}.
›

lemma (in is_cf_adjunction) cf_adj_Comp_commute_RL:
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "f : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 a"
    and "k : a ↦𝔇 a'"
  shows 
    "𝔊⦇ArrMap⦈⦇k⦈ ∘Aℭ (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈⦇f⦈ =
      (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈∙)⦇ArrVal⦈⦇k ∘A𝔇 f⦈"
proof-
  from 
    assms 
    is_cf_adjunction_axioms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have φ_x_a: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ :
    Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦cat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  note φ_x_a_f = 
    cat_Set_ArrVal_app_vrange[OF φ_x_a, unfolded in_Hom_iff, OF assms(2)]
  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have φ_x_a': 
    "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈∙ :
      Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a' ↦cat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a'⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from is_cf_adjunction_axioms this assms have x_k:
    "[ℭ⦇CId⦈⦇x⦈, k]∘ : [x, a]∘ ↦op_cat ℭ ×C 𝔇 [x, a']∘"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from 
    NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈∙ ∘Acat_Set α cf_hom 𝔇 [𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈, k]∘ =
      cf_hom ℭ [ℭ⦇CId⦈⦇x⦈, 𝔊⦇ArrMap⦈⦇k⦈]∘ ∘Acat_Set α Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙"
    (is ‹?lhs = ?rhs›)
    by (*slow*)
      (
        cs_prems cs_ist_simple
          cs_simp: cat_cs_simps
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms φ_x_a' 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?lhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈∙)⦇ArrVal⦈⦇k ∘A𝔇 f⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms φ_x_a_f 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?rhs⦇ArrVal⦈⦇f⦈ = 𝔊⦇ArrMap⦈⦇k⦈ ∘Aℭ (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈⦇f⦈"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  ultimately show ?thesis by simp
qed

lemma (in is_cf_adjunction) cf_adj_Comp_commute_LR:
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "f : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 a"
    and "h : x' ↦ℭ x"
  shows
    "(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈⦇f⦈ ∘Aℭ h =
      (Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈∙)⦇ArrVal⦈⦇f ∘A𝔇 𝔉⦇ArrMap⦈⦇h⦈⦈"
proof-
  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have φ_x_a: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ :
    Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦cat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  note φ_x_a_f = 
    cat_Set_ArrVal_app_vrange[OF φ_x_a, unfolded in_Hom_iff, OF assms(2)]
  from is_cf_adjunction_axioms assms have
    "[h, 𝔇⦇CId⦈⦇a⦈]∘ : [x, a]∘ ↦op_cat ℭ ×C 𝔇 [x', a]∘"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from 
    NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈∙ ∘Acat_Set α cf_hom 𝔇 [𝔉⦇ArrMap⦈⦇h⦈, 𝔇⦇CId⦈⦇a⦈]∘ =
      cf_hom ℭ [h, ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈]∘ ∘Acat_Set α Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙"
    (is ‹?lhs = ?rhs›)
    by (*slow*)
      (
        cs_prems
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )  
  moreover from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?lhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈∙)⦇ArrVal⦈⦇f ∘A𝔇 𝔉⦇ArrMap⦈⦇h⦈⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms φ_x_a_f 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have 
    "?rhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈⦇f⦈ ∘Aℭ h"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  ultimately show ?thesis by simp
qed



subsection‹Unit›


subsubsection‹Definition and elementary properties›


text‹See Chapter IV-1 in \cite{mac_lane_categories_2010}.›

definition cf_adjunction_unit :: "V ⇒ V" (‹ηC›)
  where "ηC Φ =
    [
      (
        λx∈∘Φ⦇AdjLeft⦈⦇HomDom⦈⦇Obj⦈.
          (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈∙)⦇ArrVal⦈⦇
            Φ⦇AdjLeft⦈⦇HomCod⦈⦇CId⦈⦇Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈
          ⦈
      ),
      cf_id (Φ⦇AdjLeft⦈⦇HomDom⦈),
      (Φ⦇AdjRight⦈) ∘CF (Φ⦇AdjLeft⦈),
      Φ⦇AdjLeft⦈⦇HomDom⦈,
      Φ⦇AdjLeft⦈⦇HomDom⦈
    ]∘"


text‹Components.›

lemma cf_adjunction_unit_components:
  shows "ηC Φ⦇NTMap⦈ =
    (
      λx∈∘Φ⦇AdjLeft⦈⦇HomDom⦈⦇Obj⦈.
        (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈∙)⦇ArrVal⦈⦇
          Φ⦇AdjLeft⦈⦇HomCod⦈⦇CId⦈⦇Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈
        ⦈
    )"
    and "ηC Φ⦇NTDom⦈ = cf_id (Φ⦇AdjLeft⦈⦇HomDom⦈)"
    and "ηC Φ⦇NTCod⦈ = (Φ⦇AdjRight⦈) ∘CF (Φ⦇AdjLeft⦈)"
    and "ηC Φ⦇NTDGDom⦈ = Φ⦇AdjLeft⦈⦇HomDom⦈"
    and "ηC Φ⦇NTDGCod⦈ = Φ⦇AdjLeft⦈⦇HomDom⦈"
  unfolding cf_adjunction_unit_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

context is_cf_adjunction
begin

lemma cf_adjunction_unit_components':
  shows "ηC Φ⦇NTMap⦈ =
    (
      λx∈∘ℭ⦇Obj⦈.
        (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, 𝔉⦇ObjMap⦈⦇x⦈⦈∙)⦇ArrVal⦈⦇𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈⦈
    )"
    and "ηC Φ⦇NTDom⦈ = cf_id ℭ"
    and "ηC Φ⦇NTCod⦈ = 𝔊 ∘CF 𝔉"
    and "ηC Φ⦇NTDGDom⦈ = ℭ"
    and "ηC Φ⦇NTDGCod⦈ = ℭ"
  unfolding cf_adjunction_unit_components
  by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+

mk_VLambda cf_adjunction_unit_components'(1)
  |vdomain cf_adjunction_unit_NTMap_vdomain[adj_cs_simps]|
  |app cf_adjunction_unit_NTMap_app[adj_cs_simps]|

end

mk_VLambda cf_adjunction_unit_components(1)
  |vsv cf_adjunction_unit_NTMap_vsv[adj_cs_intros]|

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adjunction_unit_NTMap_vdomain
  is_cf_adjunction.cf_adjunction_unit_NTMap_app


subsubsection‹Natural transformation map›

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr: 
  assumes "x ∈∘ ℭ⦇Obj⦈"
  shows "ηC Φ⦇NTMap⦈⦇x⦈ : x ↦ℭ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
proof-
  from 
    is_cf_adjunction_axioms assms
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have φ_x_𝔉x: 
    "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, 𝔉⦇ObjMap⦈⦇x⦈⦈∙ :
      Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) (𝔉⦇ObjMap⦈⦇x⦈) ↦cat_Set α 
      Hom ℭ x (𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      ) 
  from is_cf_adjunction_axioms assms have CId_𝔉x: 
    "𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 𝔉⦇ObjMap⦈⦇x⦈"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)   
  from 
    is_cf_adjunction_axioms 
    assms
    cat_Set_ArrVal_app_vrange[OF φ_x_𝔉x, unfolded in_Hom_iff, OF CId_𝔉x]
  show "ηC Φ⦇NTMap⦈⦇x⦈ : x ↦ℭ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr': 
  assumes "x ∈∘ ℭ⦇Obj⦈"
    and "a = x"
    and "b = 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
    and "ℭ' = ℭ"
  shows "ηC Φ⦇NTMap⦈⦇x⦈ : x ↦ℭ' b"
  using assms(1) unfolding assms(2-4) by (rule cf_adjunction_unit_NTMap_is_arr)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr'

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_vrange: 
  "ℛ∘ (ηC Φ⦇NTMap⦈) ⊆∘ ℭ⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_adjunction_unit_NTMap_vdomain)
  fix x assume prems: "x ∈∘ ℭ⦇Obj⦈"
  from cf_adjunction_unit_NTMap_is_arr[OF prems] show "ηC Φ⦇NTMap⦈⦇x⦈ ∈∘ ℭ⦇Arr⦈"
    by auto
qed (auto intro: adj_cs_intros)


subsubsection‹Unit is a natural transformation›

lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf:
  "ηC Φ : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
proof(intro is_ntcfI')
  show "vfsequence (ηC Φ)" unfolding cf_adjunction_unit_def by simp
  show "vcard (ηC Φ) = 5ℕ"
    unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
  from is_cf_adjunction_axioms show "cf_id ℭ : ℭ ↦↦Cα ℭ"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms show "𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms show "𝒟∘ (ηC Φ⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
  show "ηC Φ⦇NTMap⦈⦇a⦈ : cf_id ℭ⦇ObjMap⦈⦇a⦈ ↦ℭ (𝔊 ∘CF 𝔉)⦇ObjMap⦈⦇a⦈"
    if "a ∈∘ ℭ⦇Obj⦈" for a
    using is_cf_adjunction_axioms that 
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  show
    "ηC Φ⦇NTMap⦈⦇b⦈ ∘Aℭ cf_id ℭ⦇ArrMap⦈⦇f⦈ =
      (𝔊 ∘CF 𝔉)⦇ArrMap⦈⦇f⦈ ∘Aℭ ηC Φ⦇NTMap⦈⦇a⦈"
    if "f : a ↦ℭ b" for a b f
    using is_cf_adjunction_axioms that
    by 
      (
        cs_concl 
          cs_simp: 
            cf_adj_Comp_commute_RL cf_adj_Comp_commute_LR 
            cat_cs_simps  
            adj_cs_simps 
          cs_intro: cat_cs_intros adj_cs_intros
      )
qed (auto simp: cf_adjunction_unit_components')

lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf':
  assumes "𝔖 = cf_id ℭ"
    and "𝔖' = 𝔊 ∘CF 𝔉"
    and "𝔄 = ℭ"
    and "𝔅 = ℭ"
  shows "ηC Φ : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦Cα 𝔅"
  unfolding assms by (rule cf_adjunction_unit_is_ntcf)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_is_ntcf'


subsubsection‹Every component of a unit is a universal arrow›


text‹
The lemmas in this subsection are based on elements of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›

lemma (in is_cf_adjunction) cf_adj_umap_of_unit:
  assumes "x ∈∘ ℭ⦇Obj⦈" and "a ∈∘ 𝔇⦇Obj⦈"
  shows "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ =
    umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (ηC Φ⦇NTMap⦈⦇x⦈) a"
  (is ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ = ?uof_a›)
proof-

  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have φ_xa: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ :
    Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦cat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  then have dom_lhs:
    "𝒟∘ ((Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a"
    by (cs_concl cs_simp: cat_cs_simps)
  from is_cf_adjunction_axioms assms have uof_a:
    "?uof_a : Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦cat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
  then have dom_rhs: "𝒟∘ (?uof_a⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from φ_xa show arr_Set_φ_xa: "arr_Set α (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)"
      by (auto dest: cat_Set_is_arrD(1))
    from uof_a show arr_Set_uof_a: "arr_Set α ?uof_a" 
      by (auto dest: cat_Set_is_arrD(1))
    show "(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈ = ?uof_a⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix g assume prems: "g : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 a"
      from is_cf_adjunction_axioms assms prems show
        "(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙)⦇ArrVal⦈⦇g⦈ = ?uof_a⦇ArrVal⦈⦇g⦈"
        by
          (
            cs_concl
              cs_simp:
                cf_adj_Comp_commute_RL
                adj_cs_simps
                cat_cs_simps
                cat_op_simps
                cat_prod_cs_simps
              cs_intro:
                adj_cs_intros
                ntcf_cs_intros
                cat_cs_intros
                cat_op_intros
                cat_prod_cs_intros
          )
    qed (use arr_Set_φ_xa arr_Set_uof_a in auto)
  
  qed (use φ_xa uof_a in ‹cs_concl cs_simp: cat_cs_simps›)+

qed

lemma (in is_cf_adjunction) cf_adj_umap_of_unit':
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "a ∈∘ 𝔇⦇Obj⦈"
    and "η = ηC Φ⦇NTMap⦈⦇x⦈"
    and "𝔉x = 𝔉⦇ObjMap⦈⦇x⦈"
  shows "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ = umap_of 𝔊 x 𝔉x η a"
  using assms(1,2) unfolding assms(3,4) by (rule cf_adj_umap_of_unit)

lemma (in is_cf_adjunction) cf_adjunction_unit_component_is_ua_of:
  assumes "x ∈∘ ℭ⦇Obj⦈"
  shows "universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (ηC Φ⦇NTMap⦈⦇x⦈)"
    (is ‹universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) ?ηx›)
proof(rule RL.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf)
  from is_cf_adjunction_axioms assms show "𝔉⦇ObjMap⦈⦇x⦈ ∈∘ 𝔇⦇Obj⦈"
    by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms assms show 
    "ηC Φ⦇NTMap⦈⦇x⦈ : x ↦ℭ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
  show 
    "ntcf_ua_of α 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (ηC Φ⦇NTMap⦈⦇x⦈) :
      HomO.Cα𝔇(𝔉⦇ObjMap⦈⦇x⦈,-) ↦CF.iso HomO.Cαℭ(x,-) ∘CF 𝔊 :
      𝔇 ↦↦Cα cat_Set α"
    (is ‹?ntcf_ua_of : ?H𝔉 ↦CF.iso ?H𝔊 : 𝔇 ↦↦Cα cat_Set α›)
  proof(rule is_iso_ntcfI)
    from is_cf_adjunction_axioms assms show 
      "?ntcf_ua_of : ?H𝔉 ↦CF ?H𝔊 : 𝔇 ↦↦Cα cat_Set α"
      by (intro RL.cf_ntcf_ua_of_is_ntcf) 
        (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)+
    fix a assume prems: "a ∈∘ 𝔇⦇Obj⦈"
    from assms prems have 
      "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) ?ηx a"
      (is ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ = ?uof_a›)
      by (rule cf_adj_umap_of_unit)
    from assms prems L.category_axioms R.category_axioms have
      "[x, a]∘ ∈∘ (op_cat ℭ ×C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cs_intro:  cat_op_intros cat_prod_cs_intros)
    from 
      NT.iso_ntcf_is_arr_isomorphism[
        OF this, unfolded cf_adj_umap_of_unit[OF assms prems]
        ]
      is_cf_adjunction_axioms assms prems
      L.category_axioms R.category_axioms
    have "?uof_a :
      Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦isocat_Set α Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps 
            cs_intro: 
              cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
        )
    with is_cf_adjunction_axioms assms prems show 
      "?ntcf_ua_of⦇NTMap⦈⦇a⦈ : ?H𝔉⦇ObjMap⦈⦇a⦈ ↦isocat_Set α ?H𝔊⦇ObjMap⦈⦇a⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
        )
  qed
qed



subsection‹Counit›


subsubsection‹Definition and elementary properties›

definition cf_adjunction_counit :: "V ⇒ V" (‹εC›)
  where "εC Φ =
    [
      (
        λx∈∘Φ⦇AdjLeft⦈⦇HomCod⦈⦇Obj⦈.
          (Φ⦇AdjNT⦈⦇NTMap⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈, x⦈∙)¯Set⦇ArrVal⦈⦇
            Φ⦇AdjLeft⦈⦇HomDom⦈⦇CId⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈⦈
            ⦈
      ), 
      (Φ⦇AdjLeft⦈) ∘CF (Φ⦇AdjRight⦈),
      cf_id (Φ⦇AdjLeft⦈⦇HomCod⦈),
      Φ⦇AdjLeft⦈⦇HomCod⦈,
      Φ⦇AdjLeft⦈⦇HomCod⦈
    ]∘"


text‹Components.›

lemma cf_adjunction_counit_components:
  shows "εC Φ⦇NTMap⦈ =
    (
      λx∈∘Φ⦇AdjLeft⦈⦇HomCod⦈⦇Obj⦈.
        (Φ⦇AdjNT⦈⦇NTMap⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈, x⦈∙)¯Set⦇ArrVal⦈⦇
          Φ⦇AdjLeft⦈⦇HomDom⦈⦇CId⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈⦈
          ⦈
    )"
    and "εC Φ⦇NTDom⦈ = (Φ⦇AdjLeft⦈) ∘CF (Φ⦇AdjRight⦈)"
    and "εC Φ⦇NTCod⦈ = cf_id (Φ⦇AdjLeft⦈⦇HomCod⦈)"
    and "εC Φ⦇NTDGDom⦈ = Φ⦇AdjLeft⦈⦇HomCod⦈"
    and "εC Φ⦇NTDGCod⦈ = Φ⦇AdjLeft⦈⦇HomCod⦈"
  unfolding cf_adjunction_counit_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

context is_cf_adjunction
begin

lemma cf_adjunction_counit_components':
  shows "εC Φ⦇NTMap⦈ =
    (
      λx∈∘𝔇⦇Obj⦈.
        (Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈, x⦈∙)¯Set⦇ArrVal⦈⦇ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈⦈
    )"
    and "εC Φ⦇NTDom⦈ = 𝔉 ∘CF 𝔊"
    and "εC Φ⦇NTCod⦈ = cf_id 𝔇"
    and "εC Φ⦇NTDGDom⦈ = 𝔇"
    and "εC Φ⦇NTDGCod⦈ = 𝔇"
  unfolding cf_adjunction_counit_components
  by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+

mk_VLambda cf_adjunction_counit_components'(1)
  |vdomain cf_adjunction_counit_NTMap_vdomain[adj_cs_simps]|
  |app cf_adjunction_counit_NTMap_app[adj_cs_simps]|

end

mk_VLambda cf_adjunction_counit_components(1)
  |vsv cf_adjunction_counit_NTMap_vsv[adj_cs_intros]|

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adjunction_counit_NTMap_vdomain
  is_cf_adjunction.cf_adjunction_counit_NTMap_app


subsubsection‹Duality for the unit and counit›

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_op:
  "ηC (op_cf_adj Φ)⦇NTMap⦈ = εC Φ⦇NTMap⦈"
proof-
  interpret op_Φ: 
    is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
    by (rule is_cf_adjunction_op)
  show ?thesis
  proof
    (
      rule vsv_eqI, 
      unfold 
        cf_adjunction_counit_NTMap_vdomain 
        op_Φ.cf_adjunction_unit_NTMap_vdomain
    )
    fix a assume prems: "a ∈∘ op_cat 𝔇⦇Obj⦈"
    then have a: "a ∈∘ 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
    from is_cf_adjunction_axioms a show 
      "ηC (op_cf_adj Φ)⦇NTMap⦈⦇a⦈ = εC Φ⦇NTMap⦈⦇a⦈"
      by 
        (
          cs_concl
            cs_simp: cat_Set_cs_simps cat_cs_simps cat_op_simps adj_cs_simps 
            cs_intro: 
              cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed 
    (
      simp_all add: 
        cat_op_simps cf_adjunction_counit_NTMap_vsv cf_adjunction_unit_NTMap_vsv
    )
qed


lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_unit_NTMap_op

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_op:
  "εC (op_cf_adj Φ)⦇NTMap⦈ = ηC Φ⦇NTMap⦈"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_NTMap_op[
        OF is_cf_adjunction_op,
        unfolded is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj[
          OF is_cf_adjunction_axioms
          ],
        unfolded cat_op_simps,
        symmetric
      ]
   )

lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_counit_NTMap_op

lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_counit:
  "op_ntcf (εC Φ) = ηC (op_cf_adj Φ)"
  (is ‹?ε = ?η›)
proof(rule vsv_eqI)
  interpret op_Φ: 
    is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
    by (rule is_cf_adjunction_op)
  have dom_lhs: "𝒟∘ ?ε = 5ℕ" unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have dom_rhs: "𝒟∘ ?η = 5ℕ" 
    unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
  show "𝒟∘ ?ε = 𝒟∘ ?η" unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ 𝒟∘ ?ε ⟹ ?ε⦇a⦈ = ?η⦇a⦈" for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        fold nt_field_simps, 
        unfold cf_adjunction_unit_NTMap_op,
        unfold 
          cf_adjunction_counit_components' 
          cf_adjunction_unit_components'
          op_Φ.cf_adjunction_counit_components' 
          op_Φ.cf_adjunction_unit_components'
          cat_op_simps
      )
      simp_all
qed (auto simp: op_ntcf_def cf_adjunction_unit_def)

lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_counit

lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_unit:
  "op_ntcf (ηC Φ) = εC (op_cf_adj Φ)"
  (is ‹?η = ?ε›)
proof(rule vsv_eqI)
  interpret op_Φ: 
    is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
    by (rule is_cf_adjunction_op)
  have dom_lhs: "𝒟∘ ?η = 5ℕ" 
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have dom_rhs: "𝒟∘ ?ε = 5ℕ" 
    unfolding cf_adjunction_counit_def by (simp add: nat_omega_simps)
  show "𝒟∘ ?η = 𝒟∘ ?ε" unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ 𝒟∘ ?η ⟹ ?η⦇a⦈ = ?ε⦇a⦈" for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        fold nt_field_simps, 
        unfold cf_adjunction_counit_NTMap_op,
        unfold 
          cf_adjunction_counit_components' 
          cf_adjunction_unit_components'
          op_Φ.cf_adjunction_counit_components' 
          op_Φ.cf_adjunction_unit_components'
          cat_op_simps
      )
      simp_all
qed (auto simp: op_ntcf_def cf_adjunction_counit_def)

lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_unit


subsubsection‹Natural transformation map›

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr: 
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  shows "εC Φ⦇NTMap⦈⦇x⦈ : 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ↦𝔇 x"
proof-
  from assms have x: "x ∈∘ op_cat 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
  show ?thesis
    by 
      (
        rule is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr[
          OF is_cf_adjunction_op x, 
          unfolded cf_adjunction_unit_NTMap_op cat_op_simps
          ]
      )
qed

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr': 
  assumes "x ∈∘ 𝔇⦇Obj⦈"
    and "a = 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
    and "b = x"
    and "𝔇' = 𝔇"
  shows "εC Φ⦇NTMap⦈⦇x⦈ : a ↦𝔇' b"
  using assms(1) unfolding assms(2-4) by (rule cf_adjunction_counit_NTMap_is_arr)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_NTMap_is_arr'

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_vrange: 
  "ℛ∘ (εC Φ⦇NTMap⦈) ⊆∘ 𝔇⦇Arr⦈"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_NTMap_vrange[
        OF is_cf_adjunction_op,
        unfolded cf_adjunction_unit_NTMap_op cat_op_simps
        ]
    )


subsubsection‹Counit is a natural transformation›

lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf:
  "εC Φ : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
proof-
  from is_cf_adjunction.cf_adjunction_unit_is_ntcf[OF is_cf_adjunction_op] have 
    "εC Φ :
      op_cf (op_cf 𝔉 ∘CF op_cf 𝔊) ↦CF op_cf (cf_id (op_cat 𝔇)) :
      op_cat (op_cat 𝔇) ↦↦Cα op_cat (op_cat 𝔇)"
    unfolding
      is_cf_adjunction.op_ntcf_cf_adjunction_unit[
        OF is_cf_adjunction_op, unfolded cat_op_simps, symmetric
        ]
    by (rule is_ntcf.is_ntcf_op)
  then show ?thesis unfolding cat_op_simps .
qed

lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf':
  assumes "𝔖 = 𝔉 ∘CF 𝔊"
    and "𝔖' = cf_id 𝔇"
    and "𝔄 = 𝔇"
    and "𝔅 = 𝔇"
  shows "εC Φ : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦Cα 𝔅"
  unfolding assms by (rule cf_adjunction_counit_is_ntcf)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_is_ntcf'


subsubsection‹Every component of a counit is a universal arrow›

text‹
The lemmas in this subsection are based on elements of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›

lemma (in is_cf_adjunction) cf_adj_umap_fo_counit:
  assumes "x ∈∘ 𝔇⦇Obj⦈" and "a ∈∘ ℭ⦇Obj⦈"
  shows "op_cf_adj Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈∙ =
    umap_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (εC Φ⦇NTMap⦈⦇x⦈) a"
  by
    (
      rule is_cf_adjunction.cf_adj_umap_of_unit[
        OF is_cf_adjunction_op,
        unfolded cat_op_simps,
        OF assms,
        unfolded cf_adjunction_unit_NTMap_op
        ]
    )

lemma (in is_cf_adjunction) cf_adjunction_counit_component_is_ua_fo:
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  shows "universal_arrow_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (εC Φ⦇NTMap⦈⦇x⦈)"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
        OF is_cf_adjunction_op, 
        unfolded cat_op_simps, 
        OF assms,
        unfolded cf_adjunction_unit_NTMap_op
        ]
    )



subsection‹Counit-unit equations›


text‹
The following equations appear as part of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
These equations also appear in \cite{noauthor_wikipedia_2001},
where they are named ‹counit-unit equations›.
›

lemma (in is_cf_adjunction) cf_adjunction_counit_unit:
  "(𝔊 ∘CF-NTCF εC Φ) ∙NTCF (ηC Φ ∘NTCF-CF 𝔊) = ntcf_id 𝔊"
  (is ‹(𝔊 ∘CF-NTCF ?ε) ∙NTCF (?η ∘NTCF-CF 𝔊) = ntcf_id 𝔊›)
proof(rule ntcf_eqI)
  from is_cf_adjunction_axioms show 
    "(𝔊 ∘CF-NTCF ?ε) ∙NTCF (?η ∘NTCF-CF 𝔊) : 𝔊 ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  show "ntcf_id 𝔊 : 𝔊 ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ"
    by (rule is_functor.cf_ntcf_id_is_ntcf[OF RL.is_functor_axioms])
  from is_cf_adjunction_axioms have dom_lhs:
    "𝒟∘ (((𝔊 ∘CF-NTCF ?ε) ∙NTCF (?η ∘NTCF-CF 𝔊))⦇NTMap⦈) = 𝔇⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms have dom_rhs: "𝒟∘ (ntcf_id 𝔊⦇NTMap⦈) = 𝔇⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
  show "((𝔊 ∘CF-NTCF ?ε) ∙NTCF (?η ∘NTCF-CF 𝔊))⦇NTMap⦈ = ntcf_id 𝔊⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume prems: "a ∈∘ 𝔇⦇Obj⦈"
    let ?φ_aa = ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇a⦈, a⦈∙›
    have "category α (cat_Set α)"
      by (rule category_cat_Set)
    from is_cf_adjunction_axioms prems
      L.category_axioms R.category_axioms (*speedup*)
      L.category_op R.category_op (*speedup*)
      LR.is_functor_axioms RL.is_functor_axioms (*speedup*)
      category_cat_Set (*speedup*)
    have
      "?φ_aa⦇ArrVal⦈⦇?ε⦇NTMap⦈⦇a⦈⦈ =
        (?φ_aa ∘Acat_Set α ?φ_aa¯Ccat_Set α)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈⦈"
      by 
        (
          cs_concl 
            cs_simp: 
              𝒵.cat_Set_Comp_ArrVal 
              cat_Set_the_inverse[symmetric] 
              cat_cs_simps adj_cs_simps cat_prod_cs_simps 
            cs_intro:
              cat_arrow_cs_intros 
              cat_cs_intros 
              cat_op_intros 
              adj_cs_intros 
              cat_prod_cs_intros
        )
    also from is_cf_adjunction_axioms prems 
      L.category_axioms R.category_axioms (*speedup*)
      L.category_op R.category_op (*speedup*)
      LR.is_functor_axioms RL.is_functor_axioms (*speedup*)
      category_cat_Set (*speedup*)   
    have "… = ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈"
      by (
          cs_concl 
            cs_simp: cat_cs_simps category.cat_the_inverse_Comp_CId
            cs_intro: 
              cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    finally have [cat_cs_simps]: 
      "(Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇a⦈, a⦈∙)⦇ArrVal⦈⦇?ε⦇NTMap⦈⦇a⦈⦈ = 
        ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈"
      by simp
    from 
      prems is_cf_adjunction_axioms 
      L.category_axioms R.category_axioms (*speedup*)
    show "((𝔊 ∘CF-NTCF ?ε) ∙NTCF (?η ∘NTCF-CF 𝔊))⦇NTMap⦈⦇a⦈ = ntcf_id 𝔊⦇NTMap⦈⦇a⦈"
      by
        (
          cs_concl
            cs_simp:
              cat_Set_the_inverse[symmetric]
              cf_adj_Comp_commute_RL
              cat_cs_simps
              adj_cs_simps
              cat_prod_cs_simps
              cat_op_simps
            cs_intro:
              cat_arrow_cs_intros
              cat_cs_intros
              adj_cs_intros
              cat_prod_cs_intros
              cat_op_intros
        )

  qed (auto intro: cat_cs_intros)

qed simp_all

lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_counit_unit

lemma (in is_cf_adjunction) cf_adjunction_unit_counit:
  "(εC Φ ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF ηC Φ) = ntcf_id 𝔉"
  (is ‹(?ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF ?η) = ntcf_id 𝔉›)
proof-
  from is_cf_adjunction_axioms have 𝔉η:
    "𝔉 ∘CF-NTCF ?η : 𝔉 ↦CF 𝔉 ∘CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα 𝔇"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms have ε𝔉:
    "?ε ∘NTCF-CF 𝔉 : 𝔉 ∘CF 𝔊 ∘CF 𝔉 ↦CF 𝔉 : ℭ ↦↦Cα 𝔇"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from 𝔉η ε𝔉 have ε𝔉_𝔉η: 
    "(?ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF ?η) : 𝔉 ↦CF 𝔉 : ℭ ↦↦Cα 𝔇"
    by (cs_concl cs_intro: cat_cs_intros)
  from 
    is_cf_adjunction.cf_adjunction_counit_unit[
      OF is_cf_adjunction_op, 
      unfolded 
        op_ntcf_cf_adjunction_unit[symmetric]
        op_ntcf_cf_adjunction_counit[symmetric]
        op_ntcf_cf_ntcf_comp[symmetric]
        op_ntcf_ntcf_cf_comp[symmetric]
        op_ntcf_ntcf_vcomp[symmetric]
        op_ntcf_ntcf_vcomp[symmetric, OF ε𝔉 𝔉η]
        LR.cf_ntcf_id_op_cf
      ]
  have 
    "op_ntcf (op_ntcf ((?ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF ?η))) =
      op_ntcf (op_ntcf (ntcf_id 𝔉))"
    by simp
  from this is_cf_adjunction_axioms ε𝔉_𝔉η show ?thesis
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
qed

lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_unit_counit



subsection‹
Construction of an adjunction from universal morphisms 
from objects to functors
›


text‹
The subsection presents the construction of an adjunction given 
a structured collection of universal morphisms from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-i in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›


subsubsection‹
The natural transformation associated with the adjunction
constructed from universal morphisms from objects to functors
›

definition cf_adjunction_AdjNT_of_unit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η =
    [
      (λcd∈∘(op_cat (𝔉⦇HomDom⦈) ×C 𝔉⦇HomCod⦈)⦇Obj⦈.
        umap_of 𝔊 (cd⦇0⦈) (𝔉⦇ObjMap⦈⦇cd⦇0⦈⦈) (η⦇NTMap⦈⦇cd⦇0⦈⦈) (cd⦇1ℕ⦈)),
      HomO.Cα𝔉⦇HomCod⦈(𝔉-,-),
      HomO.Cα𝔉⦇HomDom⦈(-,𝔊-),
      op_cat (𝔉⦇HomDom⦈) ×C (𝔉⦇HomCod⦈),
      cat_Set α
    ]∘"


text‹Components.›

lemma cf_adjunction_AdjNT_of_unit_components:
  shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈ =
    (
      λcd∈∘(op_cat (𝔉⦇HomDom⦈) ×C 𝔉⦇HomCod⦈)⦇Obj⦈.
        umap_of 𝔊 (cd⦇0⦈) (𝔉⦇ObjMap⦈⦇cd⦇0⦈⦈) (η⦇NTMap⦈⦇cd⦇0⦈⦈)  (cd⦇1ℕ⦈)
    )"
    and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDom⦈ = HomO.Cα𝔉⦇HomCod⦈(𝔉-,-)"
    and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTCod⦈ = HomO.Cα𝔉⦇HomDom⦈(-,𝔊-)"
    and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDGDom⦈ =
      op_cat (𝔉⦇HomDom⦈) ×C (𝔉⦇HomCod⦈)"
    and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDGCod⦈ = cat_Set α"
  unfolding cf_adjunction_AdjNT_of_unit_def nt_field_simps
  by (simp_all add: nat_omega_simps)


subsubsection‹Natural transformation map›

lemma cf_adjunction_AdjNT_of_unit_NTMap_vsv[adj_cs_intros]:
  "vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)"
  unfolding cf_adjunction_AdjNT_of_unit_components by simp

lemma cf_adjunction_AdjNT_of_unit_NTMap_vdomain[adj_cs_simps]:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
  shows "𝒟∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) = (op_cat ℭ ×C 𝔇)⦇Obj⦈"
proof-
  interpret is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
  show ?thesis 
    unfolding cf_adjunction_AdjNT_of_unit_components 
    by (simp add: cat_cs_simps)
qed

lemma cf_adjunction_AdjNT_of_unit_NTMap_app[adj_cs_simps]:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇" and "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ 𝔇⦇Obj⦈"
  shows 
    "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇c, d⦈∙ =
      umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
proof-
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
  from assms have "[c, d]∘ ∈∘ (op_cat ℭ ×C 𝔇)⦇Obj⦈"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
  then show "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈ ⦇c, d⦈∙ = 
    umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
    unfolding cf_adjunction_AdjNT_of_unit_components 
    by (simp add: nat_omega_simps cat_cs_simps)
qed

lemma cf_adjunction_AdjNT_of_unit_NTMap_vrange:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
  shows "ℛ∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) ⊆∘ cat_Set α⦇Arr⦈"
proof-
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  show ?thesis
  proof
    (
      rule vsv.vsv_vrange_vsubset, 
      unfold cf_adjunction_AdjNT_of_unit_NTMap_vdomain[OF assms(3)]
    )
    show "vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)" 
      by (intro adj_cs_intros)
    fix cd assume prems: "cd ∈∘ (op_cat ℭ ×C 𝔇)⦇Obj⦈"
    then obtain c d where cd_def: "cd = [c, d]∘"
      and c: "c ∈∘ ℭ⦇Obj⦈"
      and d: "d ∈∘ 𝔇⦇Obj⦈"
      by 
        (
          auto 
            simp: cat_op_simps 
            elim: 
              cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉.HomCod.category_axioms]
        )
    from assms c d show 
      "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈ ∈∘ cat_Set α⦇Arr⦈"
      unfolding cd_def
      by (cs_concl cs_simp: cat_cs_simps adj_cs_simps cs_intro: cat_cs_intros)
  qed
qed


subsubsection‹
Adjunction constructed from universal morphisms 
from objects to functors is an adjunction
›

lemma cf_adjunction_AdjNT_of_unit_is_ntcf:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
  shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η :
    HomO.Cα𝔇(𝔉-,-) ↦CF HomO.Cαℭ(-,𝔊-) :
    op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
proof-

  interpret ℭ: category α ℭ by (rule assms(1))
  interpret 𝔇: category α 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
  interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› η by (rule assms(5))

  show ?thesis
  proof(intro is_ntcfI')

    show "vfsequence (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η)"
      unfolding cf_adjunction_AdjNT_of_unit_def by simp
    show "vcard (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η) = 5ℕ"
      unfolding cf_adjunction_AdjNT_of_unit_def by (simp add: nat_omega_simps)
    from assms(2,3) show 
      "HomO.Cα𝔇(𝔉-,-) : op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "HomO.Cαℭ(-,𝔊-) : op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      by (cs_concl cs_intro: cat_cs_intros)
    show "vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)" 
      by (intro adj_cs_intros)
    from assms show 
      "𝒟∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) = (op_cat ℭ ×C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)

    show "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈ :
      HomO.Cα𝔇(𝔉-,-)⦇ObjMap⦈⦇cd⦈ ↦cat_Set α
      HomO.Cαℭ(-,𝔊-)⦇ObjMap⦈⦇cd⦈"
      if "cd ∈∘ (op_cat ℭ ×C 𝔇)⦇Obj⦈" for cd
    proof-
      from that obtain c d 
        where cd_def: "cd = [c, d]∘" and c: "c ∈∘ ℭ⦇Obj⦈" and d: "d ∈∘ 𝔇⦇Obj⦈"
        by 
          (
            auto 
              simp: cat_op_simps 
              elim: cat_prod_2_ObjE[OF ℭ.category_op 𝔇.category_axioms]
          )
      from assms c d show ?thesis
        unfolding cd_def
        by 
          (
            cs_concl 
              cs_simp: adj_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

    show 
      "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇c'd'⦈ ∘Acat_Set α
        HomO.Cα𝔇(𝔉-,-)⦇ArrMap⦈⦇gf⦈ =
          HomO.Cαℭ(-,𝔊-)⦇ArrMap⦈⦇gf⦈ ∘Acat_Set α
            cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈"
      if "gf : cd ↦op_cat ℭ ×C 𝔇 c'd'" for cd c'd' gf 
    proof-
      from that obtain g f c c' d d'
        where gf_def: "gf = [g, f]∘"
          and cd_def: "cd = [c, d]∘"
          and c'd'_def: "c'd' = [c', d']∘"
          and g: "g : c' ↦ℭ c" 
          and f: "f : d ↦𝔇 d'"
        by 
          (
            auto 
              simp: cat_op_simps 
              elim: cat_prod_2_is_arrE[OF ℭ.category_op 𝔇.category_axioms]
          ) 
      from assms g f that show ?thesis
        unfolding gf_def cd_def c'd'_def
        by 
          (
            cs_concl 
              cs_simp: cf_umap_of_cf_hom_unit_commute adj_cs_simps cat_cs_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

  qed (auto simp: cf_adjunction_AdjNT_of_unit_components cat_cs_simps)

qed

lemma cf_adjunction_AdjNT_of_unit_is_ntcf'[adj_cs_intros]:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    and "𝔖 = HomO.Cα𝔇(𝔉-,-)"
    and "𝔖' = HomO.Cαℭ(-,𝔊-)"
    and "𝔄 = op_cat ℭ ×C 𝔇"
    and "𝔅 = cat_Set α"
  shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦Cα 𝔅"
  using assms(1-5) unfolding assms(6-9) 
  by (rule cf_adjunction_AdjNT_of_unit_is_ntcf)


subsubsection‹
Adjunction constructed from universal morphisms from objects to functors
›

definition cf_adjunction_of_unit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "cf_adjunction_of_unit α 𝔉 𝔊 η =
    [𝔉, 𝔊, cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η]∘"


text‹Components.›

lemma cf_adjunction_of_unit_components:
  shows [adj_cs_simps]: "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjLeft⦈ = 𝔉"
    and [adj_cs_simps]: "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjRight⦈ = 𝔊"
    and "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈ =
      cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η"
  unfolding cf_adjunction_of_unit_def adj_field_simps
  by (simp_all add: nat_omega_simps)


text‹Natural transformation map.›

lemma cf_adjunction_of_unit_AdjNT_NTMap_vdomain[adj_cs_simps]:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
  shows "𝒟∘ (cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈⦇NTMap⦈) = 
    (op_cat ℭ ×C 𝔇)⦇Obj⦈"
  using assms 
  unfolding cf_adjunction_of_unit_components(3)
  by (rule cf_adjunction_AdjNT_of_unit_NTMap_vdomain)

lemma cf_adjunction_of_unit_AdjNT_NTMap_app[adj_cs_simps]:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇" and "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ 𝔇⦇Obj⦈"
  shows 
    "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈∙ =
      umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
  using assms 
  unfolding cf_adjunction_of_unit_components(3)
  by (rule cf_adjunction_AdjNT_of_unit_NTMap_app)


text‹
The adjunction constructed from universal morphisms from objects to 
functors is an adjunction.
›

lemma cf_adjunction_of_unit_is_cf_adjunction:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    and "⋀x. x ∈∘ ℭ⦇Obj⦈ ⟹ universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈)"
  shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
proof-

  interpret ℭ: category α ℭ by (rule assms(1))
  interpret 𝔇: category α 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
  interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› η by (rule assms(5))

  show caou_η: "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
  proof
    (
      intro 
        is_cf_adjunctionI[OF _ _ assms(1-4)] 
        is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
          OF ℭ.category_op 𝔇.category_axioms
          ],
      unfold cat_op_simps cf_adjunction_of_unit_components
    )
    show caou_η: "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η :
      HomO.Cα𝔇(𝔉-,-) ↦CF HomO.Cαℭ(-,𝔊-) :
      op_cat ℭ ×C 𝔇 ↦↦Cα cat_Set α"
      unfolding cf_adjunction_of_unit_components
      by (rule cf_adjunction_AdjNT_of_unit_is_ntcf[OF assms(1-5)])
    fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
    have ua_of_ηa:
      "ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈) :
        HomO.Cα𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦CF.iso HomO.Cαℭ(a,-) ∘CF 𝔊 :
        𝔇 ↦↦Cα cat_Set α"
      by 
        (
          rule is_functor.cf_ntcf_ua_of_is_iso_ntcf[
            OF assms(4) assms(6)[OF prems]
            ]
        )
    have [adj_cs_simps]:
      "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF =
        ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
    proof(rule ntcf_eqI)
      from assms(1-5) caou_η prems show lhs: 
        "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF :
          HomO.Cα𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦CF HomO.Cαℭ(a,-) ∘CF 𝔊 :
          𝔇 ↦↦Cα cat_Set α"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
      from ua_of_ηa show rhs:
        "ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈) :
          HomO.Cα𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦CF HomO.Cαℭ(a,-) ∘CF 𝔊 :
          𝔇 ↦↦Cα cat_Set α"
        by (cs_concl cs_intro: ntcf_cs_intros)
      from lhs have dom_lhs:
        "𝒟∘ ((cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF)⦇NTMap⦈) =
          𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      from lhs assms(4) have dom_rhs:
        "𝒟∘ (ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      show 
        "(cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF)⦇NTMap⦈ =
          ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix d assume prems': "d ∈∘ 𝔇⦇Obj⦈"
        from assms(3,4) prems prems' show 
          "(cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF)⦇NTMap⦈⦇d⦈ =
            ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈⦇d⦈"
          by (cs_concl cs_simp: adj_cs_simps cat_cs_simps)
      qed (simp_all add: bnt_proj_snd_NTMap_vsv 𝔊.ntcf_ua_of_NTMap_vsv)
    qed simp_all
    from assms(1-5) assms(6)[OF prems] prems show 
      "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 ηop_cat ℭ,𝔇(a,-)NTCF :
        HomO.Cα𝔇(𝔉-,-)op_cat ℭ,𝔇(a,-)CF ↦CF.iso
        HomO.Cαℭ(-,𝔊-)op_cat ℭ,𝔇(a,-)CF :
        𝔇 ↦↦Cα cat_Set α"
      by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: cf_adjunction_of_unit_def nat_omega_simps)

  show "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
  proof(rule ntcf_eqI)
    from caou_η show lhs:
      "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) :
        cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
      by (cs_concl cs_intro: adj_cs_intros)
    show rhs: "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
      by (auto intro: cat_cs_intros)
    from lhs have dom_lhs:
      "𝒟∘ (ηC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    have dom_rhs: "𝒟∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈" by (auto simp: cat_cs_simps)
    show "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈ = η⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
      from assms(1-5) prems caou_η show 
        "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈⦇a⦈ = η⦇NTMap⦈⦇a⦈"
        by 
          (
            cs_concl 
              cs_simp: 
                adj_cs_simps cat_cs_simps cf_adjunction_of_unit_components(3) 
              cs_intro: cat_cs_intros
          )
    qed (auto intro: adj_cs_intros)
  qed simp_all

qed



subsection‹
Construction of an adjunction from a functor and universal morphisms 
from objects to functors
›


text‹
The subsection presents the construction of an adjunction given 
a functor and a structured collection of universal morphisms 
from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-ii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›


subsubsection‹Left adjoint›

definition cf_la_of_ra :: "(V ⇒ V) ⇒ V ⇒ V ⇒ V"
  where "cf_la_of_ra F 𝔊 η =
    [
      (λx∈∘𝔊⦇HomCod⦈⦇Obj⦈. F x),
      (
        λh∈∘𝔊⦇HomCod⦈⦇Arr⦈. THE f'.
          f' : F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈) ↦𝔊⦇HomDom⦈ F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈) ∧
            η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈⦈ ∘A𝔊⦇HomCod⦈ h =
              (
                umap_of
                  𝔊
                  (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈)
                  (F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈))
                  (η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈⦈)
                  (F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈))
              )⦇ArrVal⦈⦇f'⦈
      ),
      𝔊⦇HomCod⦈,
      𝔊⦇HomDom⦈
    ]∘"


text‹Components.›

lemma cf_la_of_ra_components:
  shows "cf_la_of_ra F 𝔊 η⦇ObjMap⦈ = (λx∈∘𝔊⦇HomCod⦈⦇Obj⦈. F x)"
    and "cf_la_of_ra F 𝔊 η⦇ArrMap⦈ =
      (
        λh∈∘𝔊⦇HomCod⦈⦇Arr⦈. THE f'.
          f' : F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈) ↦𝔊⦇HomDom⦈ F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈) ∧
          η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈⦈ ∘A𝔊⦇HomCod⦈ h =
            (
              umap_of
                𝔊 
                (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈)
                (F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈))
                (η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈⦈)
                (F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈))
            )⦇ArrVal⦈⦇f'⦈
      )"
    and "cf_la_of_ra F 𝔊 η⦇HomDom⦈ = 𝔊⦇HomCod⦈"
    and "cf_la_of_ra F 𝔊 η⦇HomCod⦈ = 𝔊⦇HomDom⦈"
  unfolding cf_la_of_ra_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Object map›

mk_VLambda cf_la_of_ra_components(1)
  |vsv cf_la_of_ra_ObjMap_vsv[adj_cs_intros]|

mk_VLambda (in is_functor) 
  cf_la_of_ra_components(1)[where ?𝔊=𝔉, unfolded cf_HomCod]
  |vdomain cf_la_of_ra_ObjMap_vdomain[adj_cs_simps]|
  |app cf_la_of_ra_ObjMap_app[adj_cs_simps]|

lemmas [adj_cs_simps] =
  is_functor.cf_la_of_ra_ObjMap_vdomain
  is_functor.cf_la_of_ra_ObjMap_app
  

subsubsection‹Arrow map›

mk_VLambda cf_la_of_ra_components(2)
  |vsv cf_la_of_ra_ArrMap_vsv[adj_cs_intros]|

mk_VLambda (in is_functor) 
  cf_la_of_ra_components(2)[where ?𝔊=𝔉, unfolded cf_HomCod cf_HomDom]
  |vdomain cf_la_of_ra_ArrMap_vdomain[adj_cs_simps]|
  |app cf_la_of_ra_ArrMap_app| (*not for general use*)

lemmas [adj_cs_simps] = is_functor.cf_la_of_ra_ArrMap_vdomain

lemma (in is_functor) cf_la_of_ra_ArrMap_app':
  assumes "h : a ↦𝔅 b"
  shows 
    "cf_la_of_ra F 𝔉 η⦇ArrMap⦈⦇h⦈ =
      (
        THE f'.
          f' : F a ↦𝔄 F b ∧
          η⦇NTMap⦈⦇b⦈ ∘A𝔅 h = umap_of 𝔉 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
      )"
proof-
  from assms have h: "h ∈∘ 𝔅⦇Arr⦈" by (simp add: cat_cs_intros)
  from assms have h_Dom: "𝔅⦇Dom⦈⦇h⦈ = a" and h_Cod: "𝔅⦇Cod⦈⦇h⦈ = b"
    by (simp_all add: cat_cs_simps)
  show ?thesis by (rule cf_la_of_ra_ArrMap_app[OF h, unfolded h_Dom h_Cod])
qed

lemma cf_la_of_ra_ArrMap_app_unique:
  assumes "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "f : a ↦ℭ b"
    and "universal_arrow_of 𝔊 a (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
    and "universal_arrow_of 𝔊 b (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
  shows "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : F a ↦𝔇 F b"
    and "η⦇NTMap⦈⦇b⦈ ∘Aℭ f = umap_of
      𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈⦈"
    and "⋀f'.
      ⟦
        f' : F a ↦𝔇 F b;
        η⦇NTMap⦈⦇b⦈ ∘Aℭ f = umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
      ⟧ ⟹ cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ = f'"
proof-

  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(1))

  from assms(2) have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" 
    by (simp_all add: cat_cs_intros)
  note ua_η_a = 𝔊.universal_arrow_ofD[OF assms(3)]
  note ua_η_b = 𝔊.universal_arrow_ofD[OF assms(4)]
  from ua_η_b(2) have [cat_cs_intros]: 
    "⟦ c = b; c' = 𝔊⦇ObjMap⦈⦇cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈⦈ ⟧ ⟹
      η⦇NTMap⦈⦇b⦈ : c ↦ℭ c'"
    for c c'
    by auto
  from assms(1,2) ua_η_a(2) have ηa_f:
    "η⦇NTMap⦈⦇b⦈ ∘Aℭ f : a ↦ℭ 𝔊⦇ObjMap⦈⦇cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(1,2) have lara_a: "cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈ = F a"
    and lara_b: "cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈ = F b"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)+

  from theD
    [
      OF 
        ua_η_a(3)[OF ua_η_b(1) ηa_f, unfolded lara_a lara_b] 
        𝔊.cf_la_of_ra_ArrMap_app'[OF assms(2), of F η]
    ]
  show "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : F a ↦𝔇 F b"
    and "η⦇NTMap⦈⦇b⦈ ∘Aℭ f = umap_of
      𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈⦈"
    and "⋀f'.
      ⟦
        f' : F a ↦𝔇 F b;
        η⦇NTMap⦈⦇b⦈ ∘Aℭ f = umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
      ⟧ ⟹ cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ = f'"
    by blast+

qed

lemma cf_la_of_ra_ArrMap_app_is_arr[adj_cs_intros]:
  assumes "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "f : a ↦ℭ b"
    and "universal_arrow_of 𝔊 a (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
    and "universal_arrow_of 𝔊 b (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
    and "Fa = F a"
    and "Fb = F b"
  shows "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : Fa ↦𝔇 Fb"
  using assms(1-4) unfolding assms(5,6) by (rule cf_la_of_ra_ArrMap_app_unique)


subsubsection‹
An adjunction constructed from a functor and universal morphisms 
from objects to functors is an adjunction
›

lemma cf_la_of_ra_is_functor:
  assumes "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of 𝔊 c (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
    and "⋀c c' h. h : c ↦ℭ c' ⟹
      𝔊⦇ArrMap⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇h⦈⦈ ∘Aℭ (η⦇NTMap⦈⦇c⦈) =
        (η⦇NTMap⦈⦇c'⦈) ∘Aℭ h"
  shows "cf_la_of_ra F 𝔊 η : ℭ ↦↦Cα 𝔇" (is ‹?𝔉 : ℭ ↦↦Cα 𝔇›)
proof-

  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(1))

  show "cf_la_of_ra F 𝔊 η : ℭ ↦↦Cα 𝔇"
  proof(rule is_functorI')

    show "vfsequence ?𝔉" unfolding cf_la_of_ra_def by auto
    show "vcard ?𝔉 = 4ℕ" 
      unfolding cf_la_of_ra_def by (simp add: nat_omega_simps)
    show "ℛ∘ (?𝔉⦇ObjMap⦈) ⊆∘ 𝔇⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold 𝔊.cf_la_of_ra_ObjMap_vdomain)
      fix x assume "x ∈∘ ℭ⦇Obj⦈"
      with assms(1) show "?𝔉⦇ObjMap⦈⦇x⦈ ∈∘ 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: adj_cs_simps cs_intro: assms(2))
    qed (auto intro: adj_cs_intros)

    show "?𝔉⦇ArrMap⦈⦇f⦈ : ?𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 ?𝔉⦇ObjMap⦈⦇b⦈"
      if "f : a ↦ℭ b" for a b f
    proof-
      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" 
        by (simp_all add: cat_cs_intros)
      have ua_η_a: "universal_arrow_of 𝔊 a (?𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
        and ua_η_b: "universal_arrow_of 𝔊 b (?𝔉⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
        by (intro assms(3)[OF a] assms(3)[OF b])+
      from a b cf_la_of_ra_ArrMap_app_unique(1)[OF assms(1) that ua_η_a ua_η_b] 
      show ?thesis 
        by (cs_concl cs_simp: adj_cs_simps)
    qed

    show "?𝔉⦇ArrMap⦈⦇g ∘Aℭ f⦈ = ?𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔇 ?𝔉⦇ArrMap⦈⦇f⦈"
      if "g : b ↦ℭ c" and "f : a ↦ℭ b" for b c g a f
    proof-

      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" and c: "c ∈∘ ℭ⦇Obj⦈" 
        by (simp_all add: cat_cs_intros)
      from assms(1) that have gf: "g ∘Aℭ f : a ↦ℭ c"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      note ua_η_a = assms(3)[OF a]
        and ua_η_b = assms(3)[OF b]
        and ua_η_c = assms(3)[OF c]

      note lara_f = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(2) ua_η_a ua_η_b]
      note lara_g = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(1) ua_η_b ua_η_c]
      note lara_gf = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) gf ua_η_a ua_η_c]

      note ua_η_a = 𝔊.universal_arrow_ofD[OF ua_η_a]
        and ua_η_b = 𝔊.universal_arrow_ofD[OF ua_η_b]
        and ua_η_c = 𝔊.universal_arrow_ofD[OF ua_η_c]
      
      from ua_η_a(2) assms(1) that have ηa: 
        "η⦇NTMap⦈⦇a⦈ : a ↦ℭ 𝔊⦇ObjMap⦈⦇F a⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from ua_η_b(2) assms(1) that have ηb: 
        "η⦇NTMap⦈⦇b⦈ : b ↦ℭ 𝔊⦇ObjMap⦈⦇F b⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from ua_η_c(2) assms(1) that have ηc: 
        "η⦇NTMap⦈⦇c⦈ : c ↦ℭ 𝔊⦇ObjMap⦈⦇F c⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)

      from assms(1) that ηc have
        "η⦇NTMap⦈⦇c⦈ ∘Aℭ (g ∘Aℭ f) = (η⦇NTMap⦈⦇c⦈ ∘Aℭ g) ∘Aℭ f"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      also from assms(1) lara_g(1) that(2) ηb have "… =
        𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇g⦈⦈ ∘Aℭ (η⦇NTMap⦈⦇b⦈ ∘Aℭ f)"
        by 
          (
            cs_concl 
              cs_simp: lara_g(2) cat_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      also from assms(1) lara_f(1) ηa have "… =
        𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇g⦈⦈ ∘Aℭ 
          (𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ η⦇NTMap⦈⦇a⦈)"
        by (cs_concl cs_simp: lara_f(2) cat_cs_simps)
      finally have [symmetric, cat_cs_simps]: 
        "η⦇NTMap⦈⦇c⦈ ∘Aℭ (g ∘Aℭ f) = …".
      from assms(1) this ηa ηb ηc lara_g(1) lara_f(1) have 
        "η⦇NTMap⦈⦇c⦈ ∘Aℭ (g ∘Aℭ f) =
          umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F c)⦇ArrVal⦈⦇?𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔇
          ?𝔉⦇ArrMap⦈⦇f⦈⦈"
        by 
          ( 
            cs_concl 
              cs_simp: adj_cs_simps cat_cs_simps 
              cs_intro: adj_cs_intros cat_cs_intros
          )
      moreover from assms(1) lara_g(1) lara_f(1) have 
        "?𝔉⦇ArrMap⦈⦇g⦈ ∘A𝔇 ?𝔉⦇ArrMap⦈⦇f⦈ : F a ↦𝔇 F c"
        by (cs_concl cs_intro: adj_cs_intros cat_cs_intros)
      ultimately show ?thesis by (intro lara_gf(3))

    qed

    show "?𝔉⦇ArrMap⦈⦇ℭ⦇CId⦈⦇c⦈⦈ = 𝔇⦇CId⦈⦇?𝔉⦇ObjMap⦈⦇c⦈⦈" if "c ∈∘ ℭ⦇Obj⦈" for c 
    proof-
      note lara_c = cf_la_of_ra_ArrMap_app_unique[
          OF 
            assms(1) 
            𝔊.HomCod.cat_CId_is_arr[OF that] 
            assms(3)[OF that] 
            assms(3)[OF that]
          ]
      from assms(1) that have 𝔇c: "𝔇⦇CId⦈⦇F c⦈ : F c ↦𝔇 F c "
        by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
      from 𝔊.universal_arrow_ofD(2)[OF assms(3)[OF that]] assms(1) that have ηc: 
        "η⦇NTMap⦈⦇c⦈ : c ↦ℭ 𝔊⦇ObjMap⦈⦇F c⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from assms(1) that ηc have 
        "η⦇NTMap⦈⦇c⦈ ∘Aℭ ℭ⦇CId⦈⦇c⦈ =
          umap_of 𝔊 c (F c) (η⦇NTMap⦈⦇c⦈) (F c)⦇ArrVal⦈⦇𝔇⦇CId⦈⦇F c⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
      note [cat_cs_simps] = lara_c(3)[OF 𝔇c this]
      from assms(1) that 𝔇c show ?thesis
        by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
    qed
  qed (auto simp: cf_la_of_ra_components cat_cs_intros cat_cs_simps)

qed

lemma cf_la_of_ra_is_ntcf:  
  fixes F 𝔊 η
  defines "𝔉 ≡ cf_la_of_ra F 𝔊 η"
  assumes "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
    and "⋀c c' h. h : c ↦ℭ c' ⟹
      𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇h⦈⦈ ∘Aℭ (η⦇NTMap⦈⦇c⦈) = (η⦇NTMap⦈⦇c'⦈) ∘Aℭ h"
    and "vfsequence η"
    and "vcard η = 5ℕ"
    and "η⦇NTDom⦈ = cf_id ℭ"
    and "η⦇NTCod⦈ = 𝔊 ∘CF 𝔉"
    and "η⦇NTDGDom⦈ = ℭ"
    and "η⦇NTDGCod⦈ = ℭ"
    and "vsv (η⦇NTMap⦈)"
    and "𝒟∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
  shows "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
proof-
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(2))
  have 𝔉: "𝔉 : ℭ ↦↦Cα 𝔇"
    unfolding 𝔉_def
    by (auto intro: cf_la_of_ra_is_functor[OF assms(2-5)[unfolded assms(1)]])
  show "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
  proof(rule is_ntcfI')
    from assms(2) show "cf_id ℭ : ℭ ↦↦Cα ℭ"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(2) 𝔉 show "𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "η⦇NTMap⦈⦇a⦈ : cf_id ℭ⦇ObjMap⦈⦇a⦈ ↦ℭ (𝔊 ∘CF 𝔉)⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using assms(2) 𝔉 that 𝔊.universal_arrow_ofD(2)[OF assms(4)[OF that]]
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show 
      "η⦇NTMap⦈⦇b⦈ ∘Aℭ cf_id ℭ⦇ArrMap⦈⦇f⦈ =
        (𝔊 ∘CF 𝔉)⦇ArrMap⦈⦇f⦈ ∘Aℭ η⦇NTMap⦈⦇a⦈"
      if "f : a ↦ℭ b" for a b f
      using assms(2) 𝔉 that 
      by (cs_concl cs_simp: assms(5) cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto intro: assms(6-13))
qed

lemma cf_la_of_ra_is_unit:  
  fixes F 𝔊 η
  defines "𝔉 ≡ cf_la_of_ra F 𝔊 η"
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
    and "⋀c c' h. h : c ↦ℭ c' ⟹
      𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇h⦈⦈ ∘Aℭ (η⦇NTMap⦈⦇c⦈) = (η⦇NTMap⦈⦇c'⦈) ∘Aℭ h"
    and "vfsequence η"
    and "vcard η = 5ℕ"
    and "η⦇NTDom⦈ = cf_id ℭ"
    and "η⦇NTCod⦈ = 𝔊 ∘CF 𝔉"
    and "η⦇NTDGDom⦈ = ℭ"
    and "η⦇NTDGCod⦈ = ℭ"
    and "vsv (η⦇NTMap⦈)"
    and "𝒟∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
  shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
proof-
  note 𝔉 = cf_la_of_ra_is_functor[
    where F=F and η=η, OF assms(4-7)[unfolded 𝔉_def], simplified
    ]
  note η = cf_la_of_ra_is_ntcf[OF assms(4-15)[unfolded 𝔉_def], simplified]
  show "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
    by 
      (
        intro 
          cf_adjunction_of_unit_is_cf_adjunction
            [
              OF assms(2,3) 𝔉 assms(4) η assms(6)[unfolded 𝔉_def], 
              simplified, 
              folded 𝔉_def
            ]
      )+
qed



subsection‹
Construction of an adjunction from universal morphisms 
from functors to objects
›


subsubsection‹Definition and elementary properties›


text‹
The subsection presents the construction of an adjunction given 
a structured collection of universal morphisms from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›

definition cf_adjunction_of_counit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "cf_adjunction_of_counit α 𝔉 𝔊 ε =
    op_cf_adj (cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε))"


text‹Components.›

lemma cf_adjunction_of_counit_components:
  shows "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjLeft⦈ = op_cf (op_cf 𝔉)"
    and "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjRight⦈ = op_cf (op_cf 𝔊)"
    and "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈ = op_cf_adj_nt
      (op_cf 𝔊⦇HomDom⦈)
      (op_cf 𝔊⦇HomCod⦈)
      (cf_adjunction_AdjNT_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε))"
  unfolding 
    cf_adjunction_of_counit_def 
    op_cf_adj_components 
    cf_adjunction_of_unit_components
  by (simp_all add: cat_op_simps)


subsubsection‹Natural transformation map›

lemma cf_adjunction_of_counit_NTMap_vsv: 
  "vsv (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈)"
  unfolding cf_adjunction_of_counit_components by (rule inv_ntcf_NTMap_vsv)
  


subsubsection‹
An adjunction constructed from universal morphisms 
from functors to objects is an adjunction
›

lemma cf_adjunction_of_counit_is_cf_adjunction:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "ε : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
    and "⋀x. x ∈∘ 𝔇⦇Obj⦈ ⟹ universal_arrow_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (ε⦇NTMap⦈⦇x⦈)"
  shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
    and "𝒟∘ (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈) = 
      (op_cat ℭ ×C 𝔇)⦇Obj⦈"
    and "⋀c d. ⟦ c ∈∘ ℭ⦇Obj⦈; d ∈∘ 𝔇⦇Obj⦈ ⟧ ⟹
      cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈∙ =
        (umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯Set"
proof-

  interpret ℭ: category α ℭ by (rule assms(1))
  interpret 𝔇: category α 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ε by (rule assms(5))
  
  note cf_adjunction_of_counit_def' = 
    cf_adjunction_of_counit_def[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  
  have ua:
    "universal_arrow_of (op_cf 𝔉) x (op_cf 𝔊⦇ObjMap⦈⦇x⦈) (op_ntcf ε⦇NTMap⦈⦇x⦈)"
    if "x ∈∘ op_cat 𝔇⦇Obj⦈" for x
    using that unfolding cat_op_simps by (rule assms(6))
  
  let ?aou = ‹cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε)›
  from 
    cf_adjunction_of_unit_is_cf_adjunction
      [
        OF 
          𝔇.category_op
          ℭ.category_op
          𝔊.is_functor_op
          𝔉.is_functor_op
          ε.is_ntcf_op[unfolded cat_op_simps]
          ua,
        simplified cf_adjunction_of_counit_def[symmetric]
      ]
  have aou: "?aou : op_cf 𝔊 ⇌CF op_cf 𝔉 : op_cat 𝔇 ⇌⇌Cα op_cat ℭ"
    and η_aou: "ηC ?aou = op_ntcf ε"
    by auto
  interpret aou: 
    is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ?aou
    by (rule aou)
  from η_aou have
    "op_ntcf (ηC ?aou) = op_ntcf (op_ntcf ε)"
    by simp
  then show "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
    unfolding 
      ε.ntcf_op_ntcf_op_ntcf
      is_cf_adjunction.op_ntcf_cf_adjunction_unit[OF aou]
      cf_adjunction_of_counit_def'[symmetric]
    by (simp add: cat_op_simps)
  show aoc_ε: "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    by 
      (
        rule 
          is_cf_adjunction_op[
            OF aou, folded cf_adjunction_of_counit_def', unfolded cat_op_simps
          ]
      )
  interpret aoc_ε: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_counit α 𝔉 𝔊 ε›
    by (rule aoc_ε)

  from aoc_ε.NT.is_ntcf_axioms show
    "𝒟∘ (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈) = (op_cat ℭ ×C 𝔇)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)

  show "⋀c d. ⟦ c ∈∘ ℭ⦇Obj⦈; d ∈∘ 𝔇⦇Obj⦈ ⟧ ⟹
    cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈∙ =
      (umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯Set"
  proof-
    fix c d assume prems: "c ∈∘ ℭ⦇Obj⦈" "d ∈∘ 𝔇⦇Obj⦈"
    from assms(1-4) prems have aou_dc:
      "cf_adjunction_AdjNT_of_unit 
        α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε)⦇NTMap⦈⦇d, c⦈∙ =
        umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c"
      by (cs_concl cs_simp: cat_op_simps adj_cs_simps cs_intro: cat_op_intros)
    from assms(1-4) aou prems have ufo_ε_dc:
      "umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c :
        HomO.Cαop_cat ℭ(op_cf 𝔊-,-)⦇ObjMap⦈⦇d, c⦈∙ ↦isocat_Set α
        HomO.Cαop_cat 𝔇(-,op_cf 𝔉-)⦇ObjMap⦈⦇d, c⦈∙"
      by 
        (
          cs_concl 
            cs_simp: 
              aou_dc[symmetric] cf_adjunction_of_unit_components(3)[symmetric]
            cs_intro: 
              is_iso_ntcf.iso_ntcf_is_arr_isomorphism' 
              adj_cs_intros 
              cat_cs_intros 
              cat_op_intros
              cat_prod_cs_intros
        )
    from 
      assms(1-4) 
      aoc_ε[unfolded cf_adjunction_of_counit_def'] 
      aou 
      prems 
      ufo_ε_dc
    show
      "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈∙ =
        (umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯Set"
      unfolding cf_adjunction_of_counit_def'
      by 
        ( 
          cs_concl 
            cs_simp: cat_op_simps adj_cs_simps cat_cs_simps cat_Set_cs_simps 
            cs_intro: adj_cs_intros cat_cs_intros cat_prod_cs_intros
        )
  qed

qed



subsection‹
Construction of an adjunction from a functor and universal morphisms
from functors to objects
›


text‹
The subsection presents the construction of an adjunction given 
a functor and a structured collection of universal morphisms 
from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iv in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›


subsubsection‹Definition and elementary properties›

definition cf_ra_of_la :: "(V ⇒ V) ⇒ V ⇒ V ⇒ V"
  where "cf_ra_of_la F 𝔉 ε = op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε))"


subsubsection‹Object map›

lemma cf_ra_of_la_ObjMap_vsv[adj_cs_intros]: "vsv (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈)"
  unfolding cf_ra_of_la_def op_cf_components by (auto intro: adj_cs_intros)

lemma (in is_functor) cf_ra_of_la_ObjMap_vdomain: 
  "𝒟∘ (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈) = 𝔅⦇Obj⦈"
  unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps 
  by (simp add: cat_cs_simps)

lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_vdomain

lemma (in is_functor) cf_ra_of_la_ObjMap_app: 
  assumes "d ∈∘ 𝔅⦇Obj⦈"
  shows "cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈ = F d"
  using assms 
  unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
  by (simp add: cat_cs_simps)

lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_app


subsubsection‹Arrow map›

lemma cf_ra_of_la_ArrMap_app_unique:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
    and "f : a ↦𝔇 b"
    and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇a⦈) (ε⦇NTMap⦈⦇a⦈)"
    and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇b⦈) (ε⦇NTMap⦈⦇b⦈)"
  shows "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : F a ↦ℭ F b"
    and "f ∘A𝔇 ε⦇NTMap⦈⦇a⦈ =
      umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈⦈"
    and "⋀f'.
      ⟦
        f' : F a ↦ℭ F b;
        f ∘A𝔇 ε⦇NTMap⦈⦇a⦈ = umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇f'⦈
      ⟧ ⟹ cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ = f'"
proof-
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
  from assms(2) have op_f: "f : b ↦op_cat 𝔇 a" unfolding cat_op_simps by simp
  let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    unfolding cat_op_simps by simp_all
  note ua_η_a = 𝔉.universal_arrow_foD[OF assms(3)]
    and ua_η_b = 𝔉.universal_arrow_foD[OF assms(4)]
  from assms(1,2) ua_η_a(2) have [cat_op_simps]:
    "ε⦇NTMap⦈⦇a⦈ ∘Aop_cat 𝔇 f = f ∘A𝔇 ε⦇NTMap⦈⦇a⦈"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
  show "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : F a ↦ℭ F b"
    and "f ∘A𝔇 ε⦇NTMap⦈⦇a⦈ =
      umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈⦈"
    and "⋀f'.
      ⟦
        f' : F a ↦ℭ F b;
        f ∘A𝔇 ε⦇NTMap⦈⦇a⦈ = umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇f'⦈
      ⟧ ⟹ cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ = f'"
    by 
      (
        intro 
          cf_la_of_ra_ArrMap_app_unique
            [
              where η=‹op_ntcf ε› and F=F,
                OF 𝔉.is_functor_op op_f, 
                unfolded 
                  𝔉.op_cf_universal_arrow_of 
                  lara_ObjMap_eq_op
                  lara_ArrMap_eq_op,
                folded cf_ra_of_la_def,
                unfolded cat_op_simps,
                OF assms(4,3)
            ]
      )+
qed

lemma cf_ra_of_la_ArrMap_app_is_arr[adj_cs_intros]:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
    and "f : a ↦𝔇 b"
    and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇a⦈) (ε⦇NTMap⦈⦇a⦈)"
    and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇b⦈) (ε⦇NTMap⦈⦇b⦈)"
    and "Fa = F a"
    and "Fb = F b"
  shows "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : Fa ↦ℭ Fb"
  using assms(1-4) unfolding assms(5,6) by (rule cf_ra_of_la_ArrMap_app_unique)


subsubsection‹
An adjunction constructed from a functor and universal morphisms 
from functors to objects is an adjunction
›

lemma op_cf_cf_la_of_ra_op[cat_op_simps]: 
  "op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)) = cf_ra_of_la F 𝔉 ε"
  unfolding cf_ra_of_la_def by simp

lemma cf_ra_of_la_commute_op:
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
    and "⋀d d' h. h : d ↦𝔇 d' ⟹
      ε⦇NTMap⦈⦇d'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ =
        h ∘A𝔇 ε⦇NTMap⦈⦇d⦈"
    and "h : c' ↦𝔇 c"
  shows "𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ ∘Aop_cat 𝔇 ε⦇NTMap⦈⦇c⦈ =
    ε⦇NTMap⦈⦇c'⦈ ∘Aop_cat 𝔇 h"
proof-
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
  from assms(4) have c': "c' ∈∘ 𝔇⦇Obj⦈" and c: "c ∈∘ 𝔇⦇Obj⦈" by auto
  note ua_η_c' = 𝔉.universal_arrow_foD[OF assms(2)[OF c']]
    and ua_η_c = 𝔉.universal_arrow_foD[OF assms(2)[OF c]]
  note rala_f = cf_ra_of_la_ArrMap_app_unique[
      OF assms(1) assms(4) assms(2)[OF c'] assms(2)[OF c]
      ]
  from assms(1) assms(4) ua_η_c'(2) ua_η_c(2) rala_f(1) show ?thesis
    by 
      (
        cs_concl 
          cs_simp: assms(3) cat_op_simps adj_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros
      )
qed

lemma 
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
    and "⋀d d' h. h : d ↦𝔇 d' ⟹
      ε⦇NTMap⦈⦇d'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ =
        h ∘A𝔇 ε⦇NTMap⦈⦇d⦈"
  shows cf_ra_of_la_is_functor: "cf_ra_of_la F 𝔉 ε : 𝔇 ↦↦Cα ℭ"
    and cf_la_of_ra_op_is_functor:  
      "cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) : op_cat 𝔇 ↦↦Cα op_cat ℭ"
proof-
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
  have 𝔉h_εc:
    "𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ ∘Aop_cat 𝔇 ε⦇NTMap⦈⦇c⦈ =
      ε⦇NTMap⦈⦇c'⦈ ∘Aop_cat 𝔇 h"
    if "h : c' ↦𝔇 c" for c c' h
  proof-
    from that have c': "c' ∈∘ 𝔇⦇Obj⦈" and c: "c ∈∘ 𝔇⦇Obj⦈" by auto
    note ua_η_c' = 𝔉.universal_arrow_foD[OF assms(3)[OF c']]
      and ua_η_c = 𝔉.universal_arrow_foD[OF assms(3)[OF c]]
    note rala_f = cf_ra_of_la_ArrMap_app_unique[
        OF assms(1) that assms(3)[OF c'] assms(3)[OF c]
        ]
    from assms(1) that ua_η_c'(2) ua_η_c(2) rala_f(1) show ?thesis
      by 
        (
          cs_concl 
            cs_simp: assms(4) cat_op_simps adj_cs_simps cat_cs_simps 
            cs_intro: cat_cs_intros
        )
  qed
  let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
  show "cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) : op_cat 𝔇 ↦↦Cα op_cat ℭ"
    by 
      (
        intro cf_la_of_ra_is_functor
          [
            where F=F and η=‹op_ntcf ε›,
            OF 𝔉.is_functor_op,
            unfolded cat_op_simps,
            OF assms(2),
            simplified,
            unfolded lara_ObjMap_eq_op lara_ArrMap_eq_op,
            folded cf_ra_of_la_def,
            OF assms(3) 𝔉h_εc
         ]
      )
  from 
    is_functor.is_functor_op[
      OF this, unfolded cat_op_simps, folded cf_ra_of_la_def
      ]
  show "cf_ra_of_la F 𝔉 ε : 𝔇 ↦↦Cα ℭ".
qed

lemma cf_ra_of_la_is_ntcf:  
  fixes F 𝔉 ε
  defines "𝔊 ≡ cf_ra_of_la F 𝔉 ε"
  assumes "𝔉 : ℭ ↦↦Cα 𝔇"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
    and "⋀d d' h. h : d ↦𝔇 d' ⟹
      ε⦇NTMap⦈⦇d'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇h⦈⦈ = h ∘A𝔇 ε⦇NTMap⦈⦇d⦈"
    and "vfsequence ε"
    and "vcard ε = 5ℕ"
    and "ε⦇NTDom⦈ = 𝔉 ∘CF 𝔊"
    and "ε⦇NTCod⦈ = cf_id 𝔇"
    and "ε⦇NTDGDom⦈ = 𝔇"
    and "ε⦇NTDGCod⦈ = 𝔇"
    and "vsv (ε⦇NTMap⦈)"
    and "𝒟∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
  shows "ε : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
proof-

  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(2))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 
    unfolding 𝔊_def
    by (auto intro: cf_ra_of_la_is_functor[OF assms(2-5)[unfolded assms(1)]])
  interpret op_ε: is_functor 
    α ‹op_cat 𝔇› ‹op_cat ℭ› ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
    by 
      (
        intro cf_la_of_ra_op_is_functor[
          where F=F and ε=ε, OF assms(2,3,4,5)[unfolded 𝔊_def], simplified
          ]
      )
  interpret ε: vfsequence ε by (rule assms(6))

  have [cat_op_simps]: "op_ntcf (op_ntcf ε) = ε"
  proof(rule vsv_eqI)
    have dom_lhs: "𝒟∘ (op_ntcf (op_ntcf ε)) = 5ℕ"
      unfolding op_ntcf_def by (simp add: nat_omega_simps)
    from assms(7) show "𝒟∘ (op_ntcf (op_ntcf ε)) = 𝒟∘ ε" 
      by (simp add: dom_lhs ε.vfsequence_vdomain)   
    have sup: 
      "op_ntcf (op_ntcf ε)⦇NTDom⦈ = ε⦇NTDom⦈" 
      "op_ntcf (op_ntcf ε)⦇NTCod⦈ = ε⦇NTCod⦈" 
      "op_ntcf (op_ntcf ε)⦇NTDGDom⦈ = ε⦇NTDGDom⦈" 
      "op_ntcf (op_ntcf ε)⦇NTDGCod⦈ = ε⦇NTDGCod⦈" 
      unfolding op_ntcf_components assms(8-11) cat_op_simps
      by simp_all
    show "a ∈∘ 𝒟∘ (op_ntcf (op_ntcf ε)) ⟹ op_ntcf (op_ntcf ε)⦇a⦈ = ε⦇a⦈" for a
      by (unfold dom_lhs, elim_in_numeral, fold nt_field_simps, unfold sup)
        (simp_all add: cat_op_simps)
  qed (auto simp: op_ntcf_def)

  let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)

  have seq: "vfsequence (op_ntcf ε)" unfolding op_ntcf_def by auto
  have card: "vcard (op_ntcf ε) = 5ℕ" 
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have op_cf_NTCod: "op_cf (ε⦇NTCod⦈) = cf_id (op_cat 𝔇)"
    unfolding assms(9) cat_op_simps by simp

  from assms(2) have op_cf_NTDom:
    "op_cf (ε⦇NTDom⦈) = op_cf 𝔉 ∘CF cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)"
    unfolding assms(8) cat_op_simps 𝔊_def 
    by (simp_all add: cat_op_simps cf_ra_of_la_def del: op_cf_cf_la_of_ra_op)
  have "op_ntcf ε :
    cf_id (op_cat 𝔇) ↦CF op_cf 𝔉 ∘CF cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) :
    op_cat 𝔇 ↦↦Cα op_cat 𝔇"
    by 
      (
        auto intro: cf_la_of_ra_is_ntcf
          [
            where F=F and η=‹op_ntcf ε›,
            OF is_functor.is_functor_op[OF assms(2)],
            unfolded cat_op_simps,
            OF assms(3),
            simplified,
            unfolded 
              lara_ObjMap_eq_op 
              lara_ArrMap_eq_op 
              cf_ra_of_la_def[symmetric],
            OF assms(4)[unfolded 𝔊_def],
            simplified,
            OF cf_ra_of_la_commute_op[
              OF assms(2,4,5)[unfolded 𝔊_def], simplified
              ],
            simplified,
            OF seq card _ op_cf_NTDom _ _ assms(12),
            unfolded assms(8-11,13) cat_op_simps
          ]
      )
  from is_ntcf.is_ntcf_op[OF this, unfolded cat_op_simps 𝔊_def[symmetric]] show 
    "ε : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇".

qed

lemma cf_ra_of_la_is_counit: 
  fixes F 𝔉 ε
  defines "𝔊 ≡ cf_ra_of_la F 𝔉 ε"
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "⋀d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
    and "⋀d d' h. h : d ↦𝔇 d' ⟹
      ε⦇NTMap⦈⦇d'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇h⦈⦈ = h ∘A𝔇 ε⦇NTMap⦈⦇d⦈"
    and "vfsequence ε"
    and "vcard ε = 5ℕ"
    and "ε⦇NTDom⦈ = 𝔉 ∘CF 𝔊"
    and "ε⦇NTCod⦈ = cf_id 𝔇"
    and "ε⦇NTDGDom⦈ = 𝔇"
    and "ε⦇NTDGCod⦈ = 𝔇"
    and "vsv (ε⦇NTMap⦈)"
    and "𝒟∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
  shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
proof-
  note 𝔉 = cf_ra_of_la_is_functor[
    where F=F and ε=ε, OF assms(4-7)[unfolded 𝔊_def], simplified
    ]
  note ε = cf_ra_of_la_is_ntcf[OF assms(4-15)[unfolded 𝔊_def], simplified]
  show "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
    by 
      (
        intro 
          cf_adjunction_of_counit_is_cf_adjunction
            [
              OF assms(2,3,4) 𝔉 ε assms(6)[unfolded 𝔊_def], 
              simplified, 
              folded 𝔊_def
            ]
      )+
qed



subsection‹Construction of an adjunction from the counit-unit equations›


text‹
The subsection presents the construction of an adjunction given 
two natural transformations satisfying counit-unit equations.
The content of this subsection follows the statement and the proof
of Theorem 2-v in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›

lemma counit_unit_is_cf_adjunction:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    and "ε : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
    and "(𝔊 ∘CF-NTCF ε) ∙NTCF (η ∘NTCF-CF 𝔊) = ntcf_id 𝔊"
    and "(ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF η) = ntcf_id 𝔉"
  shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
    and "εC (cf_adjunction_of_unit α 𝔉 𝔊 η) = ε"
proof-

  interpret ℭ: category α ℭ by (rule assms(1))
  interpret 𝔇: category α 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
  interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› η by (rule assms(5))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ε by (rule assms(6))

  have 𝔊εx_η𝔊x[cat_cs_simps]:
    "𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘Aℭ η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ = ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
    if "x ∈∘ 𝔇⦇Obj⦈" for x
  proof-
    from assms(7) have 
      "((𝔊 ∘CF-NTCF ε) ∙NTCF (η ∘NTCF-CF 𝔊))⦇NTMap⦈⦇x⦈ = ntcf_id 𝔊⦇NTMap⦈⦇x⦈"
      by simp
    from this assms(1-6) that show 
      "𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘Aℭ η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ = 
        ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed
  have [cat_cs_simps]:
    "𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘Aℭ (η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ∘Aℭ f) =
      ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ∘Aℭ f"
    if "x ∈∘ 𝔇⦇Obj⦈" and "f : a ↦ℭ 𝔊⦇ObjMap⦈⦇x⦈" for x f a
    using assms(1-6) that
    by (intro ℭ.cat_assoc_helper)
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

  have [cat_cs_simps]:
    "ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇η⦇NTMap⦈⦇x⦈⦈ = 𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
    if "x ∈∘ ℭ⦇Obj⦈" for x
  proof-
    from assms(8) have 
      "((ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF η))⦇NTMap⦈⦇x⦈ = ntcf_id 𝔉⦇NTMap⦈⦇x⦈"
      by simp
    from this assms(1-6) that show
      "ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇η⦇NTMap⦈⦇x⦈⦈ = 𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed

  have ua_𝔉x_ηx: "universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈)"
    if "x ∈∘ ℭ⦇Obj⦈" for x 
  proof(intro is_functor.universal_arrow_ofI)
    from assms(3) that show "𝔉⦇ObjMap⦈⦇x⦈ ∈∘ 𝔇⦇Obj⦈"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms(3-6) that show "η⦇NTMap⦈⦇x⦈ : x ↦ℭ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems': "r' ∈∘ 𝔇⦇Obj⦈" "u' : x ↦ℭ 𝔊⦇ObjMap⦈⦇r'⦈"
    show "∃!f'.
      f' : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 r' ∧
      u' = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms(3-6) that prems' show 
        "ε⦇NTMap⦈⦇r'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇u'⦈ : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 r'"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from assms(3-6) prems' have 𝔊𝔉u':
        "(𝔊 ∘CF 𝔉)⦇ArrMap⦈⦇u'⦈ = 𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇u'⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      note [cat_cs_simps] = 
        η.ntcf_Comp_commute[symmetric, OF prems'(2), unfolded 𝔊𝔉u']
      from assms(3-6) that prems' show 
        "u' =
          umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇ε⦇NTMap⦈⦇r'⦈ ∘A𝔇
          𝔉⦇ArrMap⦈⦇u'⦈⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      fix f' assume prems'':
        "f' : 𝔉⦇ObjMap⦈⦇x⦈ ↦𝔇 r'"
        "u' = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇f'⦈" 
      from prems''(2,1) assms(3-6) that have u'_def:
        "u' = 𝔊⦇ArrMap⦈⦇f'⦈ ∘Aℭ η⦇NTMap⦈⦇x⦈"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from 
        ε.ntcf_Comp_commute[OF prems''(1)] 
        assms(3-6) 
        prems''(1) 
      have [cat_cs_simps]:
        "ε⦇NTMap⦈⦇r'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇f'⦈⦈ =
          f' ∘A𝔇 ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have [cat_cs_simps]:
        "ε⦇NTMap⦈⦇r'⦈ ∘A𝔇 (𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇f'⦈⦈ ∘A𝔇 f) =
          (f' ∘A𝔇 ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈) ∘A𝔇 f"
        if "f : a ↦𝔇 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈⦈" for f a
        using assms(1-6) prems''(1) prems' that
        by (intro 𝔇.cat_assoc_helper)
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )+
      from prems''(2,1) assms(3-6) that show 
        "f' = ε⦇NTMap⦈⦇r'⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇u'⦈"
        unfolding u'_def 
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
  qed (auto intro: cat_cs_intros)

  show aou: "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    by (intro cf_adjunction_of_unit_is_cf_adjunction ua_𝔉x_ηx assms(1-5))
  from ℭ.category_axioms 𝔇.category_axioms show "ηC (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
    by (cs_concl cs_intro: cf_adjunction_of_unit_is_cf_adjunction assms(1-5) ua_𝔉x_ηx)

  interpret aou: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_unit α 𝔉 𝔊 η›
    by (rule aou)

  show "εC (cf_adjunction_of_unit α 𝔉 𝔊 η) = ε"
  proof(rule ntcf_eqI)
    show ε_η: "εC (cf_adjunction_of_unit α 𝔉 𝔊 η) :
      𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
      by (rule aou.cf_adjunction_counit_is_ntcf)
    from assms(1-6) ε_η have dom_lhs:
      "𝒟∘ (εC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms(1-6) ε_η have dom_rhs: "𝒟∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show "εC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈ = ε⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔇⦇Obj⦈"
      with aou.is_cf_adjunction_axioms assms(1-6) show 
        "εC (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈⦇a⦈ = ε⦇NTMap⦈⦇a⦈"
        by 
          (
            cs_concl
              cs_intro:
                cat_arrow_cs_intros
                cat_op_intros
                cat_cs_intros
                cat_prod_cs_intros
              cs_simp: 
                aou.cf_adj_umap_of_unit'[symmetric]
                cat_Set_the_inverse[symmetric]
                adj_cs_simps cat_cs_simps cat_op_simps
          )
    qed (auto simp: adj_cs_intros)
  qed (auto simp: assms) 

qed

lemma counit_unit_cf_adjunction_of_counit_is_cf_adjunction:
  assumes "category α ℭ"
    and "category α 𝔇"
    and "𝔉 : ℭ ↦↦Cα 𝔇"
    and "𝔊 : 𝔇 ↦↦Cα ℭ"
    and "η : cf_id ℭ ↦CF 𝔊 ∘CF 𝔉 : ℭ ↦↦Cα ℭ"
    and "ε : 𝔉 ∘CF 𝔊 ↦CF cf_id 𝔇 : 𝔇 ↦↦Cα 𝔇"
    and "(𝔊 ∘CF-NTCF ε) ∙NTCF (η ∘NTCF-CF 𝔊) = ntcf_id 𝔊"
    and "(ε ∘NTCF-CF 𝔉) ∙NTCF (𝔉 ∘CF-NTCF η) = ntcf_id 𝔉"
  shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    and "ηC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = η"
    and "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
proof-

  interpret ℭ: category α ℭ by (rule assms(1))
  interpret 𝔇: category α 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
  interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
  interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› η by (rule assms(5))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ε by (rule assms(6))

  have unit_op: "cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε) :
    op_cf 𝔊 ⇌CF op_cf 𝔉 : op_cat 𝔇 ⇌⇌Cα op_cat ℭ"
    by (rule counit_unit_is_cf_adjunction(1)[where ε=‹op_ntcf η›])
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            𝔊.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+
  then show aou: "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
    unfolding cf_adjunction_of_counit_def
    by
      (
        subst 𝔉.cf_op_cf_op_cf[symmetric],
        subst 𝔊.cf_op_cf_op_cf[symmetric],
        subst ℭ.cat_op_cat_op_cat[symmetric],
        subst 𝔇.cat_op_cat_op_cat[symmetric],
        rule is_cf_adjunction_op
      )

  interpret aou: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_counit α 𝔉 𝔊 ε›
    by (rule aou)

  show "ηC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = η"
    unfolding cf_adjunction_of_counit_def
    by (*slow*)
      (
        cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_counit[symmetric], 
        rule unit_op, 
        cs_concl_step counit_unit_is_cf_adjunction(3)[where ε=‹op_ntcf η›],
        insert ℭ.category_op 𝔇.category_op
      )
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            𝔊.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+ 

  show "εC (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
    unfolding cf_adjunction_of_counit_def
    by
      (
        cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_unit[symmetric], 
        rule unit_op, 
        cs_concl_step counit_unit_is_cf_adjunction(2)[where ε=‹op_ntcf η›],
        insert ℭ.category_op 𝔇.category_op
      )
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            𝔊.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+

qed



subsection‹Adjoints are unique up to isomorphism›


text‹
The content of the following subsection is based predominantly on
the statement and the proof of Corollary 1 in 
Chapter IV-1 in \cite{mac_lane_categories_2010}. However, similar 
results can also be found in section 4 in \cite{riehl_category_2016}
and in subsection 2.1 in \cite{bodo_categories_1970}.
›


subsubsection‹Definitions and elementary properties›

definition cf_adj_LR_iso :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ =
    [
      (
        λx∈∘ℭ⦇Obj⦈. THE f'.
        let
          η = ηC Φ;
          η' = ηC Ψ;
          𝔉x = 𝔉⦇ObjMap⦈⦇x⦈;
          𝔉'x = 𝔉'⦇ObjMap⦈⦇x⦈
        in
          f' : 𝔉x ↦𝔇 𝔉'x ∧
          η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x (𝔉x) (η⦇NTMap⦈⦇x⦈) (𝔉'x)⦇ArrVal⦈⦇f'⦈
      ),
      𝔉,
      𝔉',
      ℭ,
      𝔇
    ]∘"

definition cf_adj_RL_iso :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ =
    [
      (
        λx∈∘𝔇⦇Obj⦈. THE f'.
        let
          ε = εC Φ;
          ε' = εC Ψ;
          𝔊x = 𝔊⦇ObjMap⦈⦇x⦈;
          𝔊'x = 𝔊'⦇ObjMap⦈⦇x⦈
        in
          f' : 𝔊'x ↦ℭ 𝔊x ∧
          ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
      ),
      𝔊',
      𝔊,
      𝔇,
      ℭ
    ]∘"


text‹Components.›

lemma cf_adj_LR_iso_components:
  shows "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈ =
    (
      λx∈∘ℭ⦇Obj⦈. THE f'.
      let
        η = ηC Φ;
        η' = ηC Ψ;
        𝔉x = 𝔉⦇ObjMap⦈⦇x⦈;
        𝔉'x = 𝔉'⦇ObjMap⦈⦇x⦈
      in
        f' : 𝔉x ↦𝔇 𝔉'x ∧
        η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈
    )"
    and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDom⦈ = 𝔉"
    and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTCod⦈ = 𝔉'"
    and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDGDom⦈ = ℭ"
    and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDGCod⦈ = 𝔇"
  unfolding cf_adj_LR_iso_def nt_field_simps
  by (simp_all add: nat_omega_simps) (*slow*)

lemma cf_adj_RL_iso_components:
  shows "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈ =
    (
        λx∈∘𝔇⦇Obj⦈. THE f'.
        let
          ε = εC Φ;
          ε' = εC Ψ;
          𝔊x = 𝔊⦇ObjMap⦈⦇x⦈;
          𝔊'x = 𝔊'⦇ObjMap⦈⦇x⦈
        in
          f' : 𝔊'x ↦ℭ 𝔊x ∧
          ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
    )"
    and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDom⦈ = 𝔊'"
    and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTCod⦈ = 𝔊"
    and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDGDom⦈ = 𝔇"
    and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDGCod⦈ = ℭ"
  unfolding cf_adj_RL_iso_def nt_field_simps
  by (simp_all add: nat_omega_simps) (*slow*)


subsubsection‹Natural transformation map›

lemma cf_adj_LR_iso_vsv[adj_cs_intros]: 
  "vsv (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈)"
  unfolding cf_adj_LR_iso_components by simp

lemma cf_adj_RL_iso_vsv[adj_cs_intros]: 
  "vsv (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈)"
  unfolding cf_adj_RL_iso_components by simp

lemma cf_adj_LR_iso_vdomain[adj_cs_simps]:
  "𝒟∘ (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈) = ℭ⦇Obj⦈"
  unfolding cf_adj_LR_iso_components by simp

lemma cf_adj_RL_iso_vdomain[adj_cs_simps]:
  "𝒟∘ (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈) = 𝔇⦇Obj⦈"
  unfolding cf_adj_RL_iso_components by simp

lemma cf_adj_LR_iso_app:
  fixes ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ
  assumes "x ∈∘ ℭ⦇Obj⦈"
  defines "𝔉x ≡ 𝔉⦇ObjMap⦈⦇x⦈"
    and "𝔉'x ≡ 𝔉'⦇ObjMap⦈⦇x⦈"
    and "η ≡ ηC Φ" 
    and "η' ≡ ηC Ψ"
  shows "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈⦇x⦈ =
    (
      THE f'.
        f' : 𝔉x ↦𝔇 𝔉'x ∧
        η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈
    )"
  using assms(1) unfolding cf_adj_LR_iso_components assms(2-5) by simp meson

lemma cf_adj_RL_iso_app:
  fixes ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  defines "𝔊x ≡ 𝔊⦇ObjMap⦈⦇x⦈"
    and "𝔊'x ≡ 𝔊'⦇ObjMap⦈⦇x⦈"
    and "ε ≡ εC Φ" 
    and "ε' ≡ εC Ψ"
  shows "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈⦇x⦈ =
    (
      THE f'.
        f' : 𝔊'x ↦ℭ 𝔊x ∧
        ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
    )"
  using assms(1) unfolding cf_adj_RL_iso_components assms(2-5) Let_def by simp

lemma cf_adj_LR_iso_app_unique:
  fixes ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
    and "Ψ : 𝔉' ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
    and "x ∈∘ ℭ⦇Obj⦈"
  defines "𝔉x ≡ 𝔉⦇ObjMap⦈⦇x⦈"
    and "𝔉'x ≡ 𝔉'⦇ObjMap⦈⦇x⦈"
    and "η ≡ ηC Φ" 
    and "η' ≡ ηC Ψ"
    and "f ≡ cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈⦇x⦈"
  shows
    "∃!f'.
      f' : 𝔉x ↦𝔇 𝔉'x ∧
      η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
    "f : 𝔉x ↦iso𝔇 𝔉'x"
    "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))
  note 𝔉a_η =
    is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
      OF assms(1) assms(3), folded assms(4-8)
      ]
  note 𝔉'a_η = 
    is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
      OF assms(2) assms(3), folded assms(4-8)
      ]
  from 
    is_functor.cf_universal_arrow_of_unique[
      OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η, folded assms(4-8)
      ]
  obtain f' 
    where f': "f' : 𝔉x ↦𝔇 𝔉'x"
      and η'_def: 
        "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
      and unique_f': 
        "⟦
          f'' : 𝔉x ↦𝔇 𝔉'x;
          η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f''⦈
        ⟧ ⟹ f'' = f'"
    for f''
    by metis
  show unique_f': "∃!f'.
    f' : 𝔉x ↦𝔇 𝔉'x ∧
    η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
    by 
      (
        rule is_functor.cf_universal_arrow_of_unique[
          OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η, folded assms(4-8)
          ]
      )
  from
    theD
      [
        OF unique_f' cf_adj_LR_iso_app[
          OF assms(3), of 𝔇 𝔊 𝔉 Φ 𝔉' Ψ, folded assms(4-8)
          ]
      ]
  have f: "f : 𝔉x ↦𝔇 𝔉'x"
    and η': "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈"
    by simp_all
  show "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈" by (rule η')
  show "f : 𝔉x ↦iso𝔇 𝔉'x"
    by
      (
        rule 
          is_functor.cf_universal_arrow_of_is_arr_isomorphism[
            OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η f η'
            ]
      )
qed


subsubsection‹Main results›

lemma cf_adj_LR_iso_is_iso_functor:
  ―‹See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.›
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" and "Ψ : 𝔉' ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
  shows "∃!θ.
    θ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔇 ∧
    ηC Ψ = (𝔊 ∘CF-NTCF θ) ∙NTCF ηC Φ"
    and "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ : 𝔉 ↦CF.iso 𝔉' : ℭ ↦↦Cα 𝔇"
    and "ηC Ψ =
      (𝔊 ∘CF-NTCF cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ) ∙NTCF ηC Φ"
proof-

  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))

  let ?η = ‹ηC Φ›
  let ?η' = ‹ηC Ψ›
  let ?ΦΨ = ‹cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ›

  show 𝔉'Ψ: "?ΦΨ : 𝔉 ↦CF.iso 𝔉' : ℭ ↦↦Cα 𝔇"
  proof(intro is_iso_ntcfI is_ntcfI')

    show "vfsequence ?ΦΨ" unfolding cf_adj_LR_iso_def by auto
    show "vcard ?ΦΨ = 5ℕ" 
      unfolding cf_adj_LR_iso_def by (simp add: nat_omega_simps)
    show "?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using cf_adj_LR_iso_app_unique(2)[OF assms that] by auto

    show "?ΦΨ⦇NTMap⦈⦇b⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉'⦇ArrMap⦈⦇f⦈ ∘A𝔇 ?ΦΨ⦇NTMap⦈⦇a⦈"
      if "f : a ↦ℭ b" for a b f
    proof-

      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto
      note unique_a = cf_adj_LR_iso_app_unique[OF assms a]
      note unique_b = cf_adj_LR_iso_app_unique[OF assms b]

      from unique_a(2) have a_is_arr:
        "?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
        by auto
      from unique_b(2) have b_is_arr:
        "?ΦΨ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇b⦈"
        by auto

      interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› ?η
        by (rule Φ.cf_adjunction_unit_is_ntcf)
      interpret η': is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉'› ?η'
        by (rule Ψ.cf_adjunction_unit_is_ntcf)

      from unique_a(3) a_is_arr a b have η'_a_def: 
        "?η'⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘Aℭ ?η⦇NTMap⦈⦇a⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      from unique_b(3) b_is_arr a b have η'_b_def:
        "?η'⦇NTMap⦈⦇b⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘Aℭ ?η⦇NTMap⦈⦇b⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      
      from that a b a_is_arr have 
        "𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ 
          (𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘Aℭ ?η⦇NTMap⦈⦇a⦈) = 
          𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ ?η'⦇NTMap⦈⦇a⦈"
        by (cs_concl cs_simp: cat_cs_simps η'_a_def cs_intro: cat_cs_intros)
      also from η'.ntcf_Comp_commute[OF that, symmetric] that a b have 
        "… = ?η'⦇NTMap⦈⦇b⦈ ∘Aℭ f"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      also from that a b b_is_arr have
        "… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘Aℭ
          (?η⦇NTMap⦈⦇b⦈ ∘Aℭ f)" 
        by (cs_concl cs_simp: cat_cs_simps η'_b_def cs_intro: cat_cs_intros)
      also from that have 
        "… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘Aℭ
          ((𝔊 ∘CF 𝔉)⦇ArrMap⦈⦇f⦈ ∘Aℭ ?η⦇NTMap⦈⦇a⦈)"
        unfolding η.ntcf_Comp_commute[OF that, symmetric]
        by (cs_concl cs_simp: cat_cs_simps η'_b_def cs_intro: cat_cs_intros)
      also from that b_is_arr have 
        "… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘Aℭ
          (𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ ?η⦇NTMap⦈⦇a⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      finally have [cat_cs_simps]:
        "𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ (𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘Aℭ 
          ?η⦇NTMap⦈⦇a⦈) =
          𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘Aℭ
            (𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ ?η⦇NTMap⦈⦇a⦈)"
        by simp

      note unique_f_a = is_functor.universal_arrow_ofD
        [
          OF 
            Φ.RL.is_functor_axioms 
            Φ.cf_adjunction_unit_component_is_ua_of[OF a]
        ]

      from that a b a_is_arr b_is_arr have 𝔊𝔉f_ηa:
        "𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈  ∘Aℭ ?η'⦇NTMap⦈⦇a⦈ :
          a ↦ℭ 𝔊⦇ObjMap⦈⦇𝔉'⦇ObjMap⦈⦇b⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from b have 𝔉'b: "𝔉'⦇ObjMap⦈⦇b⦈ ∈∘ 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from unique_f_a(3)[OF 𝔉'b 𝔊𝔉f_ηa] obtain f' 
        where f': "f' : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇b⦈"
          and ηa: "𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ ?η'⦇NTMap⦈⦇a⦈ =
          umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦇ArrVal⦈⦇f'⦈"
          and unique_f':
            "⟦
              f'' : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇b⦈;
              𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘Aℭ ?η'⦇NTMap⦈⦇a⦈ =
                umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦇ArrVal⦈⦇f''⦈
             ⟧ ⟹ f'' = f'"
        for f''
        by metis
      have "?ΦΨ⦇NTMap⦈⦇b⦈ ∘A𝔇 𝔉⦇ArrMap⦈⦇f⦈ = f'"
        by (rule unique_f', insert a b a_is_arr b_is_arr that)
          (cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
      moreover have "𝔉'⦇ArrMap⦈⦇f⦈ ∘A𝔇 ?ΦΨ⦇NTMap⦈⦇a⦈ = f'"
        by (rule unique_f', insert a b a_is_arr b_is_arr that)
          (cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
      ultimately show ?thesis by simp
    qed 

  qed 
    (
      auto 
        intro: cat_cs_intros adj_cs_intros  
        simp: adj_cs_simps cf_adj_LR_iso_app_unique(2)[OF assms]
    )

  interpret 𝔉'Ψ: is_iso_ntcf α ℭ 𝔇 𝔉 𝔉' ‹?ΦΨ› by (rule 𝔉'Ψ)

  show η'_def: "?η' = 𝔊 ∘CF-NTCF ?ΦΨ ∙NTCF ηC Φ"
  proof(rule ntcf_eqI)
    have dom_lhs: "𝒟∘ (?η'⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
    have dom_rhs: "𝒟∘ ((𝔊 ∘CF-NTCF ?ΦΨ ∙NTCF ηC Φ)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
    show "?η'⦇NTMap⦈ = (𝔊 ∘CF-NTCF ?ΦΨ ∙NTCF ηC Φ)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
      note unique_a = cf_adj_LR_iso_app_unique[OF assms prems]
      from unique_a(2) have a_is_arr:
        "?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
        by auto  
      interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘CF 𝔉› ?η
        by (rule Φ.cf_adjunction_unit_is_ntcf)
      from unique_a(3) a_is_arr prems have η'_a_def: 
        "?η'⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘Aℭ ηC Φ⦇NTMap⦈⦇a⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      from prems a_is_arr show 
        "?η'⦇NTMap⦈⦇a⦈ =  (𝔊 ∘CF-NTCF ?ΦΨ ∙NTCF ?η)⦇NTMap⦈⦇a⦈"
        by (cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
    qed (auto intro: cat_cs_intros adj_cs_intros)
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)+

  show "∃!θ. θ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔇 ∧ ?η' = (𝔊 ∘CF-NTCF θ) ∙NTCF ?η"
  proof(intro ex1I conjI; (elim conjE)?)
    from 𝔉'Ψ show "?ΦΨ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔇" by auto
    show "?η' = 𝔊 ∘CF-NTCF ?ΦΨ ∙NTCF ηC Φ" by (rule η'_def)
    fix θ assume prems:
      "θ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔇"
      "?η' = 𝔊 ∘CF-NTCF θ ∙NTCF ηC Φ"
    interpret θ: is_ntcf α ℭ 𝔇 𝔉 𝔉' θ by (rule prems(1))
    from prems have η'_a: 
      "?η'⦇NTMap⦈⦇a⦈ = (𝔊 ∘CF-NTCF θ ∙NTCF ηC Φ)⦇NTMap⦈⦇a⦈" 
      for a
      by simp
    have η'a: "ηC Ψ⦇NTMap⦈⦇a⦈ =
      𝔊⦇ArrMap⦈⦇θ⦇NTMap⦈⦇a⦈⦈ ∘Aℭ ηC Φ⦇NTMap⦈⦇a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using η'_a[where a=a] that
      by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
    show "θ = ?ΦΨ"
    proof(rule ntcf_eqI)
      have dom_lhs: "𝒟∘ (θ⦇NTMap⦈) = ℭ⦇Obj⦈" by (cs_concl cs_simp: cat_cs_simps)
      have dom_rhs: "𝒟∘ (?ΦΨ⦇NTMap⦈) = ℭ⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      show "θ⦇NTMap⦈ = ?ΦΨ⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems': "a ∈∘ ℭ⦇Obj⦈"
        let ?uof = ‹umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇a⦈)›
        from cf_adj_LR_iso_app_unique[OF assms prems'] obtain f' 
          where f': "f' : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
            and η_def: "?η'⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇f'⦈"
            and unique_f': "⋀f''.
              ⟦
                f'' : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈;
                ?η'⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇f''⦈
              ⟧ ⟹ f'' = f'"
          by metis
        from prems' have θa: "θ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros)
        from η_def f' prems' have 
          "ηC Ψ⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇f'⦈ ∘Aℭ ηC Φ⦇NTMap⦈⦇a⦈"
          by 
            (
              cs_prems 
                cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
            )
        from prems' have "ηC Ψ⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇θ⦇NTMap⦈⦇a⦈⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps η'a[OF prems'] 
                cs_intro: adj_cs_intros cat_cs_intros
            )
        from unique_f'[OF θa this] have θa: "θ⦇NTMap⦈⦇a⦈ = f'".
        from prems' have Ψa: 
          "?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦𝔇 𝔉'⦇ObjMap⦈⦇a⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from prems' have "ηC Ψ⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈"
          by 
            ( 
              cs_concl 
                cs_simp: cf_adj_LR_iso_app_unique(3)[OF assms] cat_cs_simps 
                cs_intro: adj_cs_intros cat_cs_intros
            )
        from unique_f'[OF Ψa this] have 𝔉'Ψ_def: "?ΦΨ⦇NTMap⦈⦇a⦈ = f'".
        show "θ⦇NTMap⦈⦇a⦈ = ?ΦΨ⦇NTMap⦈⦇a⦈" unfolding θa 𝔉'Ψ_def ..
      qed auto
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
  qed

qed

lemma op_ntcf_cf_adj_RL_iso[cat_op_simps]:
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
    and "Ψ : 𝔉 ⇌CF 𝔊' : ℭ ⇌⇌Cα 𝔇" 
  defines "op_𝔇 ≡ op_cat 𝔇"
    and "op_ℭ ≡ op_cat ℭ"
    and "op_𝔉 ≡ op_cf 𝔉"
    and "op_𝔊 ≡ op_cf 𝔊"
    and "op_Φ ≡ op_cf_adj Φ"
    and "op_𝔊' ≡ op_cf 𝔊'"
    and "op_Ψ ≡ op_cf_adj Ψ"
  shows
    "op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ) =
      cf_adj_LR_iso op_𝔇 op_ℭ op_𝔉 op_𝔊 op_Φ op_𝔊' op_Ψ"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ‹εC Φ›
    by (rule Φ.cf_adjunction_counit_is_ntcf)
  have dom_lhs: "𝒟∘ (op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)) = 5ℕ"
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs)
    fix a assume prems: "a ∈∘ 5ℕ"
    then have "a ∈∘ 5ℕ" unfolding dom_lhs by simp
    then show 
      "op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)⦇a⦈ =
        cf_adj_LR_iso op_𝔇 op_ℭ op_𝔉 op_𝔊 op_Φ op_𝔊' op_Ψ⦇a⦈"
      by 
        (
          elim_in_numeral, 
          fold nt_field_simps, 
          unfold 
            cf_adj_LR_iso_components 
            op_ntcf_components 
            cf_adj_RL_iso_components
            Let_def
            Φ.cf_adjunction_unit_NTMap_op 
            Ψ.cf_adjunction_unit_NTMap_op
            assms(3-9)
            cat_op_simps
        )
        simp_all
  qed (auto simp: op_ntcf_def cf_adj_LR_iso_def nat_omega_simps)
qed

lemma op_ntcf_cf_adj_LR_iso[cat_op_simps]:
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" and "Ψ : 𝔉' ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
  defines "op_𝔇 ≡ op_cat 𝔇"
    and "op_ℭ ≡ op_cat ℭ"
    and "op_𝔉 ≡ op_cf 𝔉"
    and "op_𝔊 ≡ op_cf 𝔊"
    and "op_Φ ≡ op_cf_adj Φ"
    and "op_𝔉' ≡ op_cf 𝔉'"
    and "op_Ψ ≡ op_cf_adj Ψ"
  shows
    "op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ) =
      cf_adj_RL_iso op_𝔇 op_ℭ op_𝔊 op_𝔉 op_Φ op_𝔉' op_Ψ"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ‹εC Φ›
    by (rule Φ.cf_adjunction_counit_is_ntcf)
  have dom_lhs: "𝒟∘ (op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ)) = 5ℕ"
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs)
    fix a assume prems: "a ∈∘ 5ℕ"
    then show
      "op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ)⦇a⦈ =
        cf_adj_RL_iso op_𝔇 op_ℭ op_𝔊 op_𝔉 op_Φ op_𝔉' op_Ψ⦇a⦈"
      by
        (
          elim_in_numeral, 
          use nothing in 
            ‹
              fold nt_field_simps,
              unfold 
                cf_adj_LR_iso_components
                op_ntcf_components
                cf_adj_RL_iso_components
                Let_def
                Φ.op_ntcf_cf_adjunction_unit[symmetric]
                Ψ.op_ntcf_cf_adjunction_unit[symmetric]
                assms(3-9)
                cat_op_simps
            ›
        )
        simp_all
  qed (auto simp: op_ntcf_def cf_adj_RL_iso_def nat_omega_simps)
qed

lemma cf_adj_RL_iso_app_unique:
  fixes ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" 
    and "Ψ : 𝔉 ⇌CF 𝔊' : ℭ ⇌⇌Cα 𝔇" 
    and "x ∈∘ 𝔇⦇Obj⦈"
  defines "𝔊x ≡ 𝔊⦇ObjMap⦈⦇x⦈"
    and "𝔊'x ≡ 𝔊'⦇ObjMap⦈⦇x⦈"
    and "ε ≡ εC Φ" 
    and "ε' ≡ εC Ψ"
    and "f ≡ cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈⦇x⦈"
  shows
    "∃!f'.
      f' : 𝔊'x ↦ℭ 𝔊x ∧
      ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈"
    "f : 𝔊'x ↦isoℭ 𝔊x"
    "ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f⦈"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ‹εC Φ›
    by (rule Φ.cf_adjunction_counit_is_ntcf)
  show
    "∃!f'.
      f' : 𝔊'x ↦ℭ 𝔊x ∧
      ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈"
    "f : 𝔊'x ↦isoℭ 𝔊x"
    "ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f⦈"
    by 
      (
        intro cf_adj_LR_iso_app_unique
          [
            OF Φ.is_cf_adjunction_op Ψ.is_cf_adjunction_op,
            unfolded cat_op_simps,
            OF assms(3),
            unfolded Ψ.cf_adjunction_unit_NTMap_op,
            folded Φ.op_ntcf_cf_adjunction_counit,
            folded op_ntcf_cf_adj_RL_iso[OF assms(1,2)],
            unfolded cat_op_simps,
            folded assms(4-8)
          ]
      )+
qed

lemma cf_adj_RL_iso_is_iso_functor:
  ―‹See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.›
  assumes "Φ : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇" and "Ψ : 𝔉 ⇌CF 𝔊' : ℭ ⇌⇌Cα 𝔇" 
  shows "∃!θ.
    θ : 𝔊' ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ ∧
    εC Ψ = εC Φ ∙NTCF (𝔉 ∘CF-NTCF θ)"
    and "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ : 𝔊' ↦CF.iso 𝔊 : 𝔇 ↦↦Cα ℭ"
    and "εC Ψ =
      εC Φ ∙NTCF (𝔉 ∘CF-NTCF cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)"
proof-
  interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
  interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
  interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘CF 𝔊› ‹cf_id 𝔇› ‹εC Φ›
    by (rule Φ.cf_adjunction_counit_is_ntcf)
  note cf_adj_LR_iso_is_iso_functor_op = cf_adj_LR_iso_is_iso_functor
    [
      OF Φ.is_cf_adjunction_op Ψ.is_cf_adjunction_op,
      folded 
        Φ.op_ntcf_cf_adjunction_counit 
        Ψ.op_ntcf_cf_adjunction_counit
        op_ntcf_cf_adj_RL_iso[OF assms]
    ]
  from cf_adj_LR_iso_is_iso_functor_op(1) obtain θ 
    where θ: "θ : op_cf 𝔊 ↦CF op_cf 𝔊' : op_cat 𝔇 ↦↦Cα op_cat ℭ"
      and op_ntcf_ε_def: "op_ntcf (εC Ψ) =
        op_cf 𝔉 ∘CF-NTCF θ ∙NTCF op_ntcf (εC Φ)"
      and unique_θ': 
        "⟦
          θ' : op_cf 𝔊 ↦CF op_cf 𝔊' : op_cat 𝔇 ↦↦Cα op_cat ℭ;
          op_ntcf (εC Ψ) = op_cf 𝔉 ∘CF-NTCF θ' ∙NTCF op_ntcf (εC Φ)
         ⟧ ⟹ θ' = θ"
      for θ'
    by metis
  interpret θ: is_ntcf α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔊'› θ 
    by (rule θ)
  show "∃!θ. θ : 𝔊' ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ ∧ εC Ψ = εC Φ ∙NTCF (𝔉 ∘CF-NTCF θ)"
  proof(intro ex1I conjI; (elim conjE)?)
    show op_θ: "op_ntcf θ : 𝔊' ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ"
      by (rule θ.is_ntcf_op[unfolded cat_op_simps])
    from op_ntcf_ε_def have
      "op_ntcf (op_ntcf (εC Ψ)) =
        op_ntcf (op_cf 𝔉 ∘CF-NTCF θ ∙NTCF op_ntcf (εC Φ))"
      by simp
    then show ε_def: "εC Ψ = εC Φ ∙NTCF (𝔉 ∘CF-NTCF op_ntcf θ)"
      by 
        (
          cs_prems 
            cs_simp: cat_op_simps 
            cs_intro: adj_cs_intros cat_cs_intros cat_op_intros
        )
    fix θ' assume prems: 
      "θ' : 𝔊' ↦CF 𝔊 : 𝔇 ↦↦Cα ℭ"
      "εC Ψ = εC Φ ∙NTCF (𝔉 ∘CF-NTCF θ')"
    interpret θ': is_ntcf α 𝔇 ℭ 𝔊' 𝔊 θ' by (rule prems(1))   
    have "op_ntcf (εC Ψ) = op_cf 𝔉 ∘CF-NTCF op_ntcf θ' ∙NTCF op_ntcf (εC Φ)"
      by 
        (
          cs_concl 
            cs_simp: 
              prems(2) 
              op_ntcf_cf_ntcf_comp[symmetric] 
              op_ntcf_ntcf_vcomp[symmetric] 
            cs_intro: cat_cs_intros
        )
    from unique_θ'[OF θ'.is_ntcf_op this, symmetric] have
      "op_ntcf θ = op_ntcf (op_ntcf θ')"
      by simp
    then show "θ' = op_ntcf θ"  
      by (cs_prems cs_simp: cat_cs_simps cat_op_simps) simp
  qed
  from is_iso_ntcf.is_iso_ntcf_op[OF cf_adj_LR_iso_is_iso_functor_op(2)] show 
    "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ : 𝔊' ↦CF.iso 𝔊 : 𝔇 ↦↦Cα ℭ"
    by (cs_prems cs_simp: cat_op_simps cs_intro: adj_cs_intros cat_op_intros)
  from cf_adj_LR_iso_is_iso_functor_op(3) have 
    "op_ntcf (op_ntcf (εC Ψ)) =
      op_ntcf
        (
          op_cf 𝔉 ∘CF-NTCF op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ) ∙NTCF 
          op_ntcf (εC Φ)
        )"
    by simp
  from 
    this 
    cf_adj_LR_iso_is_iso_functor_op(2)[ 
      unfolded op_ntcf_cf_adj_RL_iso[OF assms]
      ]
  show "εC Ψ = εC Φ ∙NTCF (𝔉 ∘CF-NTCF cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)"
    by 
      (
        cs_prems
          cs_simp: cat_op_simps cat_op_simps 
          cs_intro: ntcf_cs_intros adj_cs_intros cat_cs_intros cat_op_intros
      )
qed



subsection‹Further properties of the adjoint functors›

lemma (in is_cf_adjunction) cf_adj_exp_cf_cat:
  ―‹See Proposition 4.4.6 in \cite{riehl_category_2016}.›
  assumes "𝒵 β" and "α ∈∘ β" and "category α 𝔍"
  shows
    "cf_adjunction_of_unit
      β
      (exp_cf_cat α 𝔉 𝔍)
      (exp_cf_cat α 𝔊 𝔍)
      (exp_ntcf_cat α (ηC Φ) 𝔍) :
      exp_cf_cat α 𝔉 𝔍 ⇌CF exp_cf_cat α 𝔊 𝔍 :
      cat_FUNCT α 𝔍 ℭ ⇌⇌Cβ cat_FUNCT α 𝔍 𝔇"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret 𝔍: category α 𝔍 by (rule assms(3))
  show ?thesis
  proof
    (
      rule counit_unit_is_cf_adjunction(1)[
        where ε = ‹exp_ntcf_cat α (εC Φ) 𝔍›
        ]
    )
    from assms show "exp_ntcf_cat α (ηC Φ) 𝔍 :
      cf_id (cat_FUNCT α 𝔍 ℭ) ↦CF exp_cf_cat α 𝔊 𝔍 ∘CF exp_cf_cat α 𝔉 𝔍 :
      cat_FUNCT α 𝔍 ℭ ↦↦Cβ cat_FUNCT α 𝔍 ℭ"
      by 
        (
          cs_concl
            cs_simp:
              cat_cs_simps cat_FUNCT_cs_simps 
              exp_cf_cat_cf_id_cat[symmetric] exp_cf_cat_cf_comp[symmetric] 
            cs_intro:
              cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    from assms show 
      "exp_ntcf_cat α (εC Φ) 𝔍 :
        exp_cf_cat α 𝔉 𝔍 ∘CF exp_cf_cat α 𝔊 𝔍 ↦CF cf_id (cat_FUNCT α 𝔍 𝔇) :
        cat_FUNCT α 𝔍 𝔇 ↦↦Cβ cat_FUNCT α 𝔍 𝔇"
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps 
              cat_FUNCT_cs_simps 
              exp_cf_cat_cf_id_cat[symmetric] 
              exp_cf_cat_cf_comp[symmetric] 
            cs_intro:
              cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    note [symmetric, cat_cs_simps] =
      ntcf_id_exp_cf_cat 
      exp_ntcf_cat_ntcf_vcomp 
      exp_ntcf_cat_ntcf_cf_comp
      exp_ntcf_cat_cf_ntcf_comp
    from assms show
      "(exp_cf_cat α 𝔊 𝔍 ∘CF-NTCF exp_ntcf_cat α (εC Φ) 𝔍) ∙NTCF
        (exp_ntcf_cat α (ηC Φ) 𝔍 ∘NTCF-CF exp_cf_cat α 𝔊 𝔍) =
        ntcf_id (exp_cf_cat α 𝔊 𝔍)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps  
            cs_intro: adj_cs_intros cat_cs_intros
        )
    from assms show
      "exp_ntcf_cat α (εC Φ) 𝔍 ∘NTCF-CF exp_cf_cat α 𝔉 𝔍 ∙NTCF
      (exp_cf_cat α 𝔉 𝔍 ∘CF-NTCF exp_ntcf_cat α (ηC Φ) 𝔍) =
      ntcf_id (exp_cf_cat α 𝔉 𝔍)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps  
            cs_intro: adj_cs_intros cat_cs_intros
        )
  qed
    (
      use assms in 
        ‹
          cs_concl
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        ›
    )+
qed

lemma (in is_cf_adjunction) cf_adj_exp_cf_cat_exp_cf_cat:
  ―‹See Proposition 4.4.6 in \cite{riehl_category_2016}.›
  assumes "𝒵 β" and "α ∈∘ β" and "category α 𝔄"
  shows
    "cf_adjunction_of_unit
      β
      (exp_cat_cf α 𝔄 𝔊)
      (exp_cat_cf α 𝔄 𝔉)
      (exp_cat_ntcf α 𝔄 (ηC Φ)) :
      exp_cat_cf α 𝔄 𝔊 ⇌CF exp_cat_cf α 𝔄 𝔉 :
      cat_FUNCT α ℭ 𝔄 ⇌⇌Cβ cat_FUNCT α 𝔇 𝔄"
proof-

  interpret β: 𝒵 β by (rule assms(1))
  interpret 𝔄: category α 𝔄 by (rule assms(3))

  show ?thesis
  proof
    (
      rule counit_unit_is_cf_adjunction(1)[
        where ε = ‹exp_cat_ntcf α 𝔄 (εC Φ)›
        ]
    )
    from assms is_cf_adjunction_axioms show
      "exp_cat_ntcf α 𝔄 (ηC Φ) :
        cf_id (cat_FUNCT α ℭ 𝔄) ↦CF exp_cat_cf α 𝔄 𝔉 ∘CF exp_cat_cf α 𝔄 𝔊 :
        cat_FUNCT α ℭ 𝔄 ↦↦Cβ cat_FUNCT α ℭ 𝔄"
      by 
        (
          cs_concl
            cs_simp:
              exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric] 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    from assms is_cf_adjunction_axioms show 
      "exp_cat_ntcf α 𝔄 (εC Φ) :
        exp_cat_cf α 𝔄 𝔊 ∘CF exp_cat_cf α 𝔄 𝔉 ↦CF cf_id (cat_FUNCT α 𝔇 𝔄) :
        cat_FUNCT α 𝔇 𝔄 ↦↦Cβ cat_FUNCT α 𝔇 𝔄"
      by
        (
          cs_concl
            cs_simp: 
              exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric] 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    note [symmetric, cat_cs_simps] =
      ntcf_id_exp_cat_cf
      exp_cat_ntcf_ntcf_vcomp
      exp_cat_ntcf_ntcf_cf_comp
      exp_cat_ntcf_cf_ntcf_comp
    from assms show
      "exp_cat_cf α 𝔄 𝔉 ∘CF-NTCF exp_cat_ntcf α 𝔄 (εC Φ) ∙NTCF
        (exp_cat_ntcf α 𝔄 (ηC Φ) ∘NTCF-CF exp_cat_cf α 𝔄 𝔉) =
        ntcf_id (exp_cat_cf α 𝔄 𝔉)"
      by
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps
            cs_intro: adj_cs_intros cat_cs_intros
        )
    from assms show
      "exp_cat_ntcf α 𝔄 (εC Φ) ∘NTCF-CF exp_cat_cf α 𝔄 𝔊 ∙NTCF
        (exp_cat_cf α 𝔄 𝔊 ∘CF-NTCF exp_cat_ntcf α 𝔄 (ηC Φ)) =
        ntcf_id (exp_cat_cf α 𝔄 𝔊)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps
            cs_intro: adj_cs_intros cat_cs_intros
        )
  qed
    (
      use assms in 
        ‹
          cs_concl
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        ›
    )+

qed

text‹\newpage›

end

Theory CZH_UCAT_Kan

(* Copyright 2021 (C) Mihails Milehins *)

section‹Simple Kan extensions›
theory CZH_UCAT_Kan
  imports 
    CZH_Elementary_Categories.CZH_ECAT_Comma
    CZH_UCAT_Limit
    CZH_UCAT_Adjoints
begin



subsection‹Background›

named_theorems ua_field_simps

definition UObj :: V where [ua_field_simps]: "UObj = 0"
definition UArr :: V where [ua_field_simps]: "UArr = 1ℕ"

named_theorems cat_Kan_cs_simps
named_theorems cat_Kan_cs_intros



subsection‹Kan extension›


subsubsection‹Definition and elementary properties›


text‹See Chapter X-3 in \cite{mac_lane_categories_2010}.›

locale is_cat_rKe = 
  AG: is_functor α 𝔅 ℭ 𝔎 + 
  Ran: is_functor α ℭ 𝔄 𝔊 +
  ntcf_rKe: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘CF 𝔎› 𝔗 ε
  for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε +
  assumes cat_rKe_ua_fo:
    "universal_arrow_fo
      (exp_cat_cf α 𝔄 𝔎)
      (cf_map 𝔗)
      (cf_map 𝔊)
      (ntcf_arrow ε)"

syntax "_is_cat_rKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ ∘CF _ ↦CF.rKeı _ :/ _ ↦C _ ↦C _)› [51, 51, 51, 51, 51, 51, 51] 51)
translations "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C ℭ ↦C 𝔄" ⇌ 
  "CONST is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε"

locale is_cat_lKe =
  AG: is_functor α 𝔅 ℭ 𝔎 +
  Lan: is_functor α ℭ 𝔄 𝔉 +
  ntcf_lKe: is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉 ∘CF 𝔎› η
  for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η +
  assumes cat_lKe_ua_fo:
    "universal_arrow_fo
      (exp_cat_cf α (op_cat 𝔄) (op_cf 𝔎))
      (cf_map 𝔗)
      (cf_map 𝔉)
      (ntcf_arrow (op_ntcf η))"

syntax "_is_cat_lKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (‹(_ :/ _ ↦CF.lKeı _ ∘CF _ :/ _ ↦C _ ↦C _)› [51, 51, 51, 51, 51, 51, 51] 51)
translations "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C 𝔄" ⇌ 
  "CONST is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η"


text‹Rules.›

lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
  assumes "α' = α"
    and "𝔊' = 𝔊"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
  shows "ε : 𝔊' ∘CF 𝔎' ↦CF.rKeα' 𝔗' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_rKe_axioms)

mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
  |intro is_cat_rKeI|
  |dest is_cat_rKeD[dest]|
  |elim is_cat_rKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
  assumes "α' = α"
    and "𝔉' = 𝔉"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
  shows "η : 𝔗' ↦CF.lKeα 𝔉' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_lKe_axioms)

mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
  |intro is_cat_lKeI|
  |dest is_cat_lKeD[dest]|
  |elim is_cat_lKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)


text‹Duality.›

lemma (in is_cat_rKe) is_cat_lKe_op:
  "op_ntcf ε :
    op_cf 𝔗 ↦CF.lKeα op_cf 𝔊 ∘CF op_cf 𝔎 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔄"
  by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔊' = op_cf 𝔊"
    and "𝔎' = op_cf 𝔎"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
  shows "op_ntcf ε : 𝔗' ↦CF.lKeα 𝔊' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_lKe_op)

lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'

lemma (in is_cat_lKe) is_cat_rKe_op:
  "op_ntcf η :
    op_cf 𝔉 ∘CF op_cf 𝔎 ↦CF.rKeα op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔄"
  by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "𝔎' = op_cf 𝔎"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
  shows "op_ntcf η : 𝔉' ∘CF 𝔎' ↦CF.rKeα 𝔗' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_rKe_op)

lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'


text‹Elementary properties.›

lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "exp_cat_cf α 𝔄 𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦C.tinyβ cat_FUNCT α 𝔅 𝔄"
  by 
    ( 
      rule exp_cat_cf_is_tiny_functor[
        OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
        ]
    )

lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "exp_cat_cf α 𝔄 𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦C.tinyβ cat_FUNCT α 𝔅 𝔄"
  by 
    ( 
      rule exp_cat_cf_is_tiny_functor[
        OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
        ]
    )


subsubsection‹Universal property›


text‹
See Chapter X-3 in \cite{mac_lane_categories_2010} and 
\cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Kan_extension}
}.
›

lemma is_cat_rKeI':
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔊 : ℭ ↦↦Cα 𝔄"
    and "ε : 𝔊 ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "⋀𝔊' ε'.
      ⟦ 𝔊' : ℭ ↦↦Cα 𝔄; ε' : 𝔊' ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄 ⟧ ⟹
        ∃!σ. σ : 𝔊' ↦CF 𝔊 : ℭ ↦↦Cα 𝔄 ∧ ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)" 
  shows "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C ℭ ↦C 𝔄"
proof-
  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔊: is_functor α ℭ 𝔄 𝔊 by (rule assms(2))
  interpret ε: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘CF 𝔎› 𝔗 ε by (rule assms(3))
  let ?𝔄𝔎 = ‹exp_cat_cf α 𝔄 𝔎›
    and ?𝔗 = ‹cf_map 𝔗›
    and ?𝔊 = ‹cf_map 𝔊›
  show ?thesis
  proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
    define β where "β = α + ω"
    have "𝒵 β" and αβ: "α ∈∘ β" 
      by (simp_all add: β_def 𝔎.𝒵_Limit_αω 𝔎.𝒵_ω_αω 𝒵_def 𝔎.𝒵_α_αω)
    then interpret β: 𝒵 β by simp 
    show "?𝔄𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦Cβ cat_FUNCT α 𝔅 𝔄"
      by 
        ( 
          cs_concl cs_intro: 
            cat_small_cs_intros 
            exp_cat_cf_is_tiny_functor[
              OF β.𝒵_axioms αβ 𝔊.HomCod.category_axioms assms(1)
              ]
        )
    from αβ assms(2) show "cf_map 𝔊 ∈∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
      unfolding cat_FUNCT_components
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
    from assms(1-3) show "ntcf_arrow ε :
      ?𝔄𝔎⦇ObjMap⦈⦇?𝔊⦈ ↦cat_FUNCT α 𝔅 𝔄 ?𝔗"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) 
            cs_intro: cat_FUNCT_cs_intros
        )
    fix 𝔉' ε' assume prems: 
      "𝔉' ∈∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
      "ε' : ?𝔄𝔎⦇ObjMap⦈⦇𝔉'⦈ ↦cat_FUNCT α 𝔅 𝔄 ?𝔗"
    from prems(1) have "𝔉' ∈∘ cf_maps α ℭ 𝔄"  
      unfolding cat_FUNCT_components(1) by simp
    then obtain 𝔉 where 𝔉'_def: "𝔉' = cf_map 𝔉" and 𝔉: "𝔉 : ℭ ↦↦Cα 𝔄" 
      by clarsimp
    note ε' = cat_FUNCT_is_arrD[OF prems(2)]
    from ε'(1) 𝔉 have ε'_is_ntcf: 
      "ntcf_of_ntcf_arrow 𝔅 𝔄 ε' : 𝔉 ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"
      by 
        ( 
          cs_prems 
            cs_simp: 𝔉'_def cat_Kan_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms(4)[OF 𝔉 ε'_is_ntcf] obtain σ
      where σ: "σ : 𝔉 ↦CF 𝔊 : ℭ ↦↦Cα 𝔄" 
        and ε'_def': "ntcf_of_ntcf_arrow 𝔅 𝔄 ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)"
        and unique_σ: "⋀σ'. 
          ⟦ 
            σ' : 𝔉 ↦CF 𝔊 : ℭ ↦↦Cα 𝔄;
            ntcf_of_ntcf_arrow 𝔅 𝔄 ε' = ε ∙NTCF (σ' ∘NTCF-CF 𝔎) 
          ⟧ ⟹ σ' = σ"
      by metis
    show "∃!f'.
      f' : 𝔉' ↦cat_FUNCT α ℭ 𝔄 ?𝔊 ∧
      ε' = umap_fo ?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) 𝔉'⦇ArrVal⦈⦇f'⦈"
    proof(intro ex1I conjI; (elim conjE)?, unfold 𝔉'_def)
      from σ show "ntcf_arrow σ : cf_map 𝔉 ↦cat_FUNCT α ℭ 𝔄 ?𝔊"
        by (cs_concl cs_intro: cat_FUNCT_cs_intros)
      from αβ assms(1-3) σ ε'(1) show 
        "ε' = umap_fo
          ?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) (cf_map 𝔉)⦇ArrVal⦈⦇ntcf_arrow σ⦈"
        by (subst ε')
          (
            cs_concl 
              cs_simp: 
                ε'_def'[symmetric] cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps 
              cs_intro: 
                cat_small_cs_intros 
                cat_cs_intros 
                cat_Kan_cs_intros
                cat_FUNCT_cs_intros
          )
      fix σ' assume prems:
        "σ' : cf_map 𝔉 ↦cat_FUNCT α ℭ 𝔄 ?𝔊"
        "ε' = umap_fo ?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) (cf_map 𝔉)⦇ArrVal⦈⦇σ'⦈"
      note σ' = cat_FUNCT_is_arrD[OF prems(1)]
      from σ'(1) 𝔉 have "ntcf_of_ntcf_arrow ℭ 𝔄 σ' : 𝔉 ↦CF 𝔊 : ℭ ↦↦Cα 𝔄"
        by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
      moreover from prems(2) prems(1) αβ assms(1-3) this ε'(1) have 
        "ntcf_of_ntcf_arrow 𝔅 𝔄 ε' =
          ε ∙NTCF (ntcf_of_ntcf_arrow ℭ 𝔄 σ' ∘NTCF-CF 𝔎)"
        by (subst (asm) ε'(2))
          (
            cs_prems 
              cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps 
              cs_intro: 
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_cs_intros
                cat_FUNCT_cs_intros
          )
      ultimately have σ_def: "σ = ntcf_of_ntcf_arrow ℭ 𝔄 σ'" 
        by (rule unique_σ[symmetric])
      show "σ' = ntcf_arrow σ"
        by (subst σ'(2), use nothing in ‹subst σ_def›)
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
  qed
qed

lemma is_cat_lKeI':
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔉 : ℭ ↦↦Cα 𝔄"
    and "η : 𝔗 ↦CF 𝔉 ∘CF 𝔎 : 𝔅 ↦↦Cα 𝔄"
    and "⋀𝔉' η'.
      ⟦ 𝔉' : ℭ ↦↦Cα 𝔄; η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎 : 𝔅 ↦↦Cα 𝔄 ⟧ ⟹
        ∃!σ. σ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔄 ∧ η' = (σ ∘NTCF-CF 𝔎) ∙NTCF η" 
  shows "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C 𝔄"
proof-
  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔉: is_functor α ℭ 𝔄 𝔉 by (rule assms(2))
  interpret η: is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉 ∘CF 𝔎› η by (rule assms(3))
  have 
    "∃!σ.
      σ : 𝔊' ↦CF op_cf 𝔉 : op_cat ℭ ↦↦Cα op_cat 𝔄 ∧
      η' = op_ntcf η ∙NTCF (σ ∘NTCF-CF op_cf 𝔎)"
    if "𝔊' : op_cat ℭ ↦↦Cα op_cat 𝔄"
      and "η' : 𝔊' ∘CF op_cf 𝔎 ↦CF op_cf 𝔗 : op_cat 𝔅 ↦↦Cα op_cat 𝔄"
    for 𝔊' η'
  proof-
    interpret 𝔊': is_functor α ‹op_cat ℭ› ‹op_cat 𝔄› 𝔊' by (rule that(1))
    interpret η': 
      is_ntcf α ‹op_cat 𝔅› ‹op_cat 𝔄› ‹𝔊' ∘CF op_cf 𝔎› ‹op_cf 𝔗› η'
      by (rule that(2))
    from assms(4)[
        OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
        OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
        ]
    obtain σ where σ: "σ : 𝔉 ↦CF op_cf 𝔊' : ℭ ↦↦Cα 𝔄" 
      and op_η'_def: "op_ntcf η' = σ ∘NTCF-CF 𝔎 ∙NTCF η"
      and unique_σ':
        "⟦
          σ' : 𝔉 ↦CF op_cf 𝔊' : ℭ ↦↦Cα 𝔄;
          op_ntcf η' = σ' ∘NTCF-CF 𝔎 ∙NTCF η
         ⟧ ⟹ σ' = σ"
      for σ'
      by metis
    interpret σ: is_ntcf α ℭ 𝔄 𝔉 ‹op_cf 𝔊'› σ by (rule σ)
    show ?thesis
    proof(intro ex1I conjI; (elim conjE)?)
      show "op_ntcf σ : 𝔊' ↦CF op_cf 𝔉 : op_cat ℭ ↦↦Cα op_cat 𝔄"
        by (rule σ.is_ntcf_op[unfolded cat_op_simps])
      from op_η'_def have "op_ntcf (op_ntcf η') = op_ntcf (σ ∘NTCF-CF 𝔎 ∙NTCF η)"
        by simp
      from this σ assms(1-3) show η'_def:
        "η' = op_ntcf η ∙NTCF (op_ntcf σ ∘NTCF-CF op_cf 𝔎)"
        by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
      fix σ' assume prems:
        "σ' : 𝔊' ↦CF op_cf 𝔉 : op_cat ℭ ↦↦Cα op_cat 𝔄"
        "η' = op_ntcf η ∙NTCF (σ' ∘NTCF-CF op_cf 𝔎)"
      interpret σ': is_ntcf α ‹op_cat ℭ› ‹op_cat 𝔄› 𝔊' ‹op_cf 𝔉› σ' 
        by (rule prems(1))
      from prems(2) have 
        "op_ntcf η' = op_ntcf (op_ntcf η ∙NTCF (σ' ∘NTCF-CF op_cf 𝔎))"
        by simp
      also have "… = op_ntcf σ' ∘NTCF-CF 𝔎 ∙NTCF η"   
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      finally have "op_ntcf η' = op_ntcf σ' ∘NTCF-CF 𝔎 ∙NTCF η" by simp
      from unique_σ'[OF σ'.is_ntcf_op[unfolded cat_op_simps] this] show 
        "σ' = op_ntcf σ" 
        by (auto simp: cat_op_simps)
    qed
  qed
  from 
    is_cat_rKeI'
      [
        OF 𝔎.is_functor_op 𝔉.is_functor_op η.is_ntcf_op[unfolded cat_op_simps], 
        unfolded cat_op_simps, 
        OF this
      ]
  interpret η: is_cat_rKe 
    α 
    ‹op_cat 𝔅› 
    ‹op_cat ℭ›
    ‹op_cat 𝔄› 
    ‹op_cf 𝔎› 
    ‹op_cf 𝔗› 
    ‹op_cf 𝔉› 
    ‹op_ntcf η›
    by simp
  show "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C 𝔄"
    by (rule η.is_cat_lKe_op[unfolded cat_op_simps])
qed

lemma (in is_cat_rKe) cat_rKe_unique:
  assumes "𝔊' : ℭ ↦↦Cα 𝔄" and "ε' : 𝔊' ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"
  shows "∃!σ. σ : 𝔊' ↦CF 𝔊 : ℭ ↦↦Cα 𝔄 ∧ ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)" 
proof-

  interpret 𝔊': is_functor α ℭ 𝔄 𝔊' by (rule assms(1))
  interpret ε': is_ntcf α 𝔅 𝔄 ‹𝔊' ∘CF 𝔎› 𝔗 ε' by (rule assms(2))

  let ?𝔗 = ‹cf_map 𝔗›
    and ?𝔊 = ‹cf_map 𝔊›
    and ?𝔊' = ‹cf_map 𝔊'›
    and ?ε = ‹ntcf_arrow ε›
    and ?ε' = ‹ntcf_arrow ε'›

  define β where "β = α + ω"
  have "𝒵 β" and αβ: "α ∈∘ β"
    by (simp_all add: β_def AG.𝒵_Limit_αω AG.𝒵_ω_αω 𝒵_def AG.𝒵_α_αω)
  then interpret β: 𝒵 β by simp
  
  interpret 𝔄𝔎: is_tiny_functor 
    β ‹cat_FUNCT α ℭ 𝔄› ‹cat_FUNCT α 𝔅 𝔄› ‹exp_cat_cf α 𝔄 𝔎›
    by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF β.𝒵_axioms αβ])

  from assms(1) have 𝔊': "?𝔊' ∈∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros)
  with assms(2) have
    "?ε' : exp_cat_cf α 𝔄 𝔎⦇ObjMap⦈⦇?𝔊'⦈ ↦cat_FUNCT α 𝔅 𝔄 ?𝔗"
    by 
      ( 
        cs_concl 
          cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps 
          cs_intro: cat_cs_intros cat_FUNCT_cs_intros
      )

  from
    is_functor.universal_arrow_foD(3)[
      OF 𝔄𝔎.is_functor_axioms cat_rKe_ua_fo 𝔊' this
      ]
  obtain f' where f': "f' : cf_map 𝔊' ↦cat_FUNCT α ℭ 𝔄 cf_map 𝔊"
    and ε'_def: "?ε' = umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇f'⦈"
    and f'_unique: 
      "⟦ 
        f'' : ?𝔊' ↦cat_FUNCT α ℭ 𝔄 ?𝔊;
        ntcf_arrow ε' = umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇f''⦈ 
       ⟧ ⟹ f'' = f'"
    for f''
    by metis
  
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    from ε'_def cat_FUNCT_is_arrD(1)[OF f'] show
      "ε' = ε ∙NTCF (ntcf_of_ntcf_arrow ℭ 𝔄 f' ∘NTCF-CF 𝔎)"
      by (subst (asm) cat_FUNCT_is_arrD(2)[OF f']) (*slow*)
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
      "ntcf_of_ntcf_arrow ℭ 𝔄 f' : 𝔊' ↦CF 𝔊 : ℭ ↦↦Cα 𝔄"
      by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
    fix σ assume prems: 
      "σ : 𝔊' ↦CF 𝔊 : ℭ ↦↦Cα 𝔄" "ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)"
    interpret σ: is_ntcf α ℭ 𝔄 𝔊' 𝔊 σ by (rule prems(1))
    from prems(1) have σ: 
      "ntcf_arrow σ : cf_map 𝔊' ↦cat_FUNCT α ℭ 𝔄 cf_map 𝔊"
      by (cs_concl cs_intro: cat_FUNCT_cs_intros)
    from prems have ε'_def: "ntcf_arrow ε' =
      umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇ntcf_arrow σ⦈"
      by 
        (
          cs_concl
            cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show "σ = ntcf_of_ntcf_arrow ℭ 𝔄 f'"
      unfolding f'_unique[OF σ ε'_def, symmetric]
      by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  qed

qed

lemma (in is_cat_lKe) cat_lKe_unique:
  assumes "𝔉' : ℭ ↦↦Cα 𝔄" and "η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎 : 𝔅 ↦↦Cα 𝔄"
  shows "∃!σ. σ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔄 ∧ η' = (σ ∘NTCF-CF 𝔎) ∙NTCF η" 
proof-

  interpret 𝔉': is_functor α ℭ 𝔄 𝔉' by (rule assms(1))
  interpret η': is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉' ∘CF 𝔎› η' by (rule assms(2))
  interpret η: is_cat_rKe 
    α ‹op_cat 𝔅› ‹op_cat ℭ› ‹op_cat 𝔄› ‹op_cf 𝔎› ‹op_cf 𝔗› ‹op_cf 𝔉› ‹op_ntcf η›
    by (rule is_cat_rKe_op)

  from η.cat_rKe_unique[OF 𝔉'.is_functor_op η'.is_ntcf_op[unfolded cat_op_simps]]
  obtain σ where σ: "σ : op_cf 𝔉' ↦CF op_cf 𝔉 : op_cat ℭ ↦↦Cα op_cat 𝔄"
    and η'_def: "op_ntcf η' = op_ntcf η ∙NTCF (σ ∘NTCF-CF op_cf 𝔎)"
    and unique_σ': "⋀σ'.
      ⟦
        σ' : op_cf 𝔉' ↦CF op_cf 𝔉 : op_cat ℭ ↦↦Cα op_cat 𝔄;
        op_ntcf η' = op_ntcf η ∙NTCF (σ' ∘NTCF-CF op_cf 𝔎) 
      ⟧ ⟹ σ' = σ"
    by metis

  interpret σ: is_ntcf α ‹op_cat ℭ› ‹op_cat 𝔄› ‹op_cf 𝔉'› ‹op_cf 𝔉› σ 
    by (rule σ)
  
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show "op_ntcf σ : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔄"
      by (rule σ.is_ntcf_op[unfolded cat_op_simps])
    have "η' = op_ntcf (op_ntcf η')" by (cs_concl cs_simp: cat_op_simps)
    also from η'_def have "… = op_ntcf (op_ntcf η ∙NTCF (σ ∘NTCF-CF op_cf 𝔎))"
      by simp
    also have "… = op_ntcf σ ∘NTCF-CF 𝔎 ∙NTCF η"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
    finally show "η' = op_ntcf σ ∘NTCF-CF 𝔎 ∙NTCF η" by simp
    fix σ' assume prems: 
      "σ' : 𝔉 ↦CF 𝔉' : ℭ ↦↦Cα 𝔄"
      "η' = σ' ∘NTCF-CF 𝔎 ∙NTCF η"
    interpret σ': is_ntcf α ℭ 𝔄 𝔉 𝔉' σ' by (rule prems(1))
    from prems(2) have "op_ntcf η' = op_ntcf (σ' ∘NTCF-CF 𝔎 ∙NTCF η)"
      by simp
    also have "… = op_ntcf η ∙NTCF (op_ntcf σ' ∘NTCF-CF op_cf 𝔎)"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
    finally have "op_ntcf η' = op_ntcf η ∙NTCF (op_ntcf σ' ∘NTCF-CF op_cf 𝔎)"
      by simp
    from unique_σ'[OF σ'.is_ntcf_op this] show "σ' = op_ntcf σ"
      by (auto simp: cat_op_simps)
  qed

qed


subsubsection‹Further properties›

lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
  assumes "𝒵 β" and "α ∈∘ β"
  shows 
    "ntcf_ua_fo β (exp_cat_cf α 𝔄 𝔎) (cf_map 𝔗) (cf_map 𝔊) (ntcf_arrow ε) :
      HomO.Cβcat_FUNCT α ℭ 𝔄(-,cf_map 𝔊) ↦CF.iso
      HomO.Cβcat_FUNCT α 𝔅 𝔄(-,cf_map 𝔗) ∘CF op_cf (exp_cat_cf α 𝔄 𝔎) :
      op_cat (cat_FUNCT α ℭ 𝔄) ↦↦Cβ cat_Set β"
proof-
  interpret 𝔄_𝔎: 
    is_tiny_functor β ‹cat_FUNCT α ℭ 𝔄› ‹cat_FUNCT α 𝔅 𝔄› ‹exp_cat_cf α 𝔄 𝔎›
    by 
      (
        rule exp_cat_cf_is_tiny_functor[
          OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
          ]
      )
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
          OF 𝔄_𝔎.is_functor_axioms cat_rKe_ua_fo
          ]
      )
qed

lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
  assumes "𝒵 β" and "α ∈∘ β"
  defines "𝔄𝔎 ≡ exp_cat_cf α (op_cat 𝔄) (op_cf 𝔎)"
    and "𝔄ℭ ≡ cat_FUNCT α (op_cat ℭ) (op_cat 𝔄)"
    and "𝔄𝔅 ≡ cat_FUNCT α (op_cat 𝔅) (op_cat 𝔄)"
  shows 
    "ntcf_ua_fo β 𝔄𝔎 (cf_map 𝔗) (cf_map 𝔉) (ntcf_arrow (op_ntcf η)) :
      HomO.Cβ𝔄ℭ(-,cf_map 𝔉) ↦CF.iso HomO.Cβ𝔄𝔅(-,cf_map 𝔗) ∘CF op_cf 𝔄𝔎 :
      op_cat 𝔄ℭ ↦↦Cβ cat_Set β"
proof-
  note simps = 𝔄ℭ_def 𝔄𝔅_def 𝔄𝔎_def
  interpret 𝔄_𝔎: is_tiny_functor β 𝔄ℭ 𝔄𝔅 𝔄𝔎
    unfolding simps
    by
      (
        rule exp_cat_cf_is_tiny_functor[
          OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
          ]
      )
  show ?thesis
    unfolding simps
    by 
      (
        rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
          OF 𝔄_𝔎.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
          ]
      )
qed



subsection‹The Kan extension›


text‹
The following subsection is based on the statement and proof of 
Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
In what follows, only the right Kan extension is considered for simplicity.
›


subsubsection‹Definition and elementary properties›

definition the_cf_rKe :: "V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
  where "the_cf_rKe α 𝔗 𝔎 lim_Obj =
    [
      (λc∈∘𝔎⦇HomCod⦈⦇Obj⦈. lim_Obj c⦇UObj⦈),
      (
        λg∈∘𝔎⦇HomCod⦈⦇Arr⦈. THE f.
          f :
            lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UObj⦈ ↦𝔗⦇HomCod⦈
            lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UObj⦈ ∧
          lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
            lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UArr⦈ ∙NTCF 
            ntcf_const ((𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈) ↓CF 𝔎) (𝔗⦇HomCod⦈) f
      ),
      𝔎⦇HomCod⦈,
      𝔗⦇HomCod⦈
    ]∘"

definition the_ntcf_rKe :: "V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
  where "the_ntcf_rKe α 𝔗 𝔎 lim_Obj =
    [
      (
        λc∈∘𝔗⦇HomDom⦈⦇Obj⦈.
          lim_Obj (𝔎⦇ObjMap⦈⦇c⦈)⦇UArr⦈⦇NTMap⦈⦇0, c, 𝔎⦇HomCod⦈⦇CId⦈⦇𝔎⦇ObjMap⦈⦇c⦈⦈⦈∙
      ),
      the_cf_rKe α 𝔗 𝔎 lim_Obj ∘CF 𝔎,
      𝔗,
      𝔗⦇HomDom⦈,
      𝔗⦇HomCod⦈
    ]∘"


text‹Components.›

lemma the_cf_rKe_components:
  shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ObjMap⦈ = 
    (λc∈∘𝔎⦇HomCod⦈⦇Obj⦈. lim_Obj c⦇UObj⦈)"
    and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈ =
    (
      λg∈∘𝔎⦇HomCod⦈⦇Arr⦈. THE f.
        f :
          lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UObj⦈ ↦𝔗⦇HomCod⦈
          lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UObj⦈ ∧
        lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
          lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UArr⦈ ∙NTCF 
          ntcf_const ((𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈) ↓CF 𝔎) (𝔗⦇HomCod⦈) f
    )"
    and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇HomDom⦈ = 𝔎⦇HomCod⦈"
    and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇HomCod⦈ = 𝔗⦇HomCod⦈"
  unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)

lemma the_ntcf_rKe_components:
  shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTMap⦈ =
      (
        λc∈∘𝔗⦇HomDom⦈⦇Obj⦈.
          lim_Obj (𝔎⦇ObjMap⦈⦇c⦈)⦇UArr⦈⦇NTMap⦈⦇0, c, 𝔎⦇HomCod⦈⦇CId⦈⦇𝔎⦇ObjMap⦈⦇c⦈⦈⦈∙
      )"
    and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDom⦈ = the_cf_rKe α 𝔗 𝔎 lim_Obj ∘CF 𝔎"
    and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTCod⦈ = 𝔗"
    and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
    and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDGCod⦈ = 𝔗⦇HomCod⦈"
  unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas the_cf_rKe_components' = the_cf_rKe_components[
    where 𝔎=𝔎 and 𝔗=𝔗 and α=α, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod
    ]

lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)

lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
    where 𝔎=𝔎 and 𝔗=𝔗 and α=α, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod 𝔗.cf_HomDom
    ]

lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)

end


subsubsection‹Functor: object map›

mk_VLambda the_cf_rKe_components(1)
  |vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)

mk_VLambda the_cf_rKe_components'(1)[OF 𝔎 𝔗]
  |vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|

lemma the_cf_rKe_ObjMap_vrange: 
  assumes "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UObj⦈ ∈∘ 𝔄⦇Obj⦈"
  shows "ℛ∘ (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ObjMap⦈) ⊆∘ 𝔄⦇Obj⦈"
  unfolding the_cf_rKe_components'[OF 𝔎 𝔗]
  by (intro vrange_VLambda_vsubset assms)

end


subsubsection‹Functor: arrow map›

mk_VLambda the_cf_rKe_components(2)
  |vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔅 ℭ 𝔎
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)

mk_VLambda the_cf_rKe_components(2)[where α=α and 𝔎=𝔎, unfolded 𝔎.cf_HomCod]
  |vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]|

context 
  fixes 𝔄 𝔗 c c' g
  assumes 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and g: "g : c ↦ℭ c'"
begin

interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemma g': "g ∈∘ ℭ⦇Arr⦈" using g by auto

mk_VLambda the_cf_rKe_components(2)[
    where α=α and 𝔎=𝔎 and 𝔗=𝔗, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod
    ]
  |app the_cf_rKe_ArrMap_app_impl'|

lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
    OF g', unfolded 𝔎.HomCod.cat_is_arrD[OF g]
    ]

end

end

lemma the_cf_rKe_ArrMap_app_impl:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "g : c ↦ℭ c'"
    and "u : r <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "u' : r' <CF.lim 𝔗 ∘CF c' O⨅CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
  shows "∃!f.
    f : r ↦𝔄 r' ∧
    u ∘NTCF-CF g A↓CF 𝔎 = u' ∙NTCF ntcf_const (c' ↓CF 𝔎) 𝔄 f"
proof-

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret u: is_cat_limit α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› r u
    by (rule assms(4))
  interpret u': is_cat_limit α ‹c' ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c' O⨅CF 𝔎› r' u'
    by (rule assms(5))

  have const_r_def:
    "cf_const (c' ↓CF 𝔎) 𝔄 r = cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎"
  proof(rule cf_eqI)
    show const_r: "cf_const (c' ↓CF 𝔎) 𝔄 r : c' ↓CF 𝔎 ↦↦Cα 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
    from assms(3) show const_r_g𝔎: 
      "cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    have ObjMap_dom_lhs: "𝒟∘ (cf_const (c' ↓CF 𝔎) 𝔄 r⦇ObjMap⦈) = c' ↓CF 𝔎⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have ObjMap_dom_rhs: 
      "𝒟∘ ((cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ObjMap⦈) = c' ↓CF 𝔎⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    have ArrMap_dom_lhs: "𝒟∘ (cf_const (c' ↓CF 𝔎) 𝔄 r⦇ArrMap⦈) = c' ↓CF 𝔎⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have ArrMap_dom_rhs: 
      "𝒟∘ ((cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ArrMap⦈) = c' ↓CF 𝔎⦇Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    show 
      "cf_const (c' ↓CF 𝔎) 𝔄 r⦇ObjMap⦈ =
        (cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix A assume prems: "A ∈∘ c' ↓CF 𝔎⦇Obj⦈"
      from prems assms obtain b f 
        where A_def: "A = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈" 
          and f: "f : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
        by auto
      from assms(1,3) prems f b show 
        "cf_const (c' ↓CF 𝔎) 𝔄 r⦇ObjMap⦈⦇A⦈ =
          (cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ObjMap⦈⦇A⦈"
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed (use assms(3) in ‹cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros›)+
    show
      "cf_const (c' ↓CF 𝔎) 𝔄 r⦇ArrMap⦈ =
        (cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      show "vsv (cf_const (c' ↓CF 𝔎) 𝔄 r⦇ArrMap⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from assms(3) show "vsv ((cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ArrMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      fix F assume prems: "F ∈∘ c' ↓CF 𝔎⦇Arr⦈"
      with prems obtain A B where F: "F : A ↦c' ↓CF 𝔎 B"
        by (auto intro: is_arrI)
      with assms obtain b f b' f' h'
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, h']∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and h': "h' : b ↦𝔅 b'"
          and f: "f : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
          and f': "f' : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
          and f'_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f = f'"
        by auto
      from prems assms(3) F g' h' f f' show
        "cf_const (c' ↓CF 𝔎) 𝔄 r⦇ArrMap⦈⦇F⦈ =
          (cf_const (c ↓CF 𝔎) 𝔄 r ∘CF g A↓CF 𝔎)⦇ArrMap⦈⦇F⦈"
        unfolding F_def A_def B_def
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp
  qed simp_all

  have 𝔗c'𝔎: "𝔗 ∘CF c' O⨅CF 𝔎 = 𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎"
  proof(rule cf_eqI)
    show "𝔗 ∘CF c' O⨅CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show " 𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps 
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )
    have ObjMap_dom_lhs: "𝒟∘ ((𝔗 ∘CF c' O⨅CF 𝔎)⦇ObjMap⦈) = c' ↓CF 𝔎⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms have ObjMap_dom_rhs: 
      "𝒟∘ ((𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ObjMap⦈) = c' ↓CF 𝔎⦇Obj⦈"
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )
    show "(𝔗 ∘CF c' O⨅CF 𝔎)⦇ObjMap⦈ = (𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      from assms show "vsv ((𝔗 ∘CF c' O⨅CF 𝔎)⦇ObjMap⦈)"
        by
          (
            cs_concl
              cs_simp: cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from assms show "vsv ((𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ObjMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      fix A assume prems: "A ∈∘ c' ↓CF 𝔎⦇Obj⦈"
      from assms(3) prems obtain b f
        where A_def: "A = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
        by auto
      from prems assms b f show 
        "(𝔗 ∘CF c' O⨅CF 𝔎)⦇ObjMap⦈⦇A⦈ =
          (𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ObjMap⦈⦇A⦈"
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp

    have ArrMap_dom_lhs: "𝒟∘ ((𝔗 ∘CF c' O⨅CF 𝔎)⦇ArrMap⦈) = c' ↓CF 𝔎⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms have ArrMap_dom_rhs:
      "𝒟∘ ((𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ArrMap⦈) = c' ↓CF 𝔎⦇Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )

    show "(𝔗 ∘CF c' O⨅CF 𝔎)⦇ArrMap⦈ = (𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      from assms show "vsv ((𝔗 ∘CF c' O⨅CF 𝔎)⦇ArrMap⦈)"
        by
          (
            cs_concl 
              cs_simp: cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from assms show "vsv ((𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ArrMap⦈)"
        by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)

      fix F assume prems: "F ∈∘ c' ↓CF 𝔎⦇Arr⦈"
      with prems obtain A B where F: "F : A ↦c' ↓CF 𝔎 B"
        unfolding cat_comma_cs_simps by (auto intro: is_arrI)
      with assms(3) obtain b f b' f' h'
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, h']∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and h': "h' : b ↦𝔅 b'"
          and f: "f : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
          and f': "f' : c' ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
          and f'_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f = f'"
        by auto
      from prems assms(3) F g' h' f f' show
        "(𝔗 ∘CF c' O⨅CF 𝔎)⦇ArrMap⦈⦇F⦈ =
          (𝔗 ∘CF c O⨅CF 𝔎 ∘CF g A↓CF 𝔎)⦇ArrMap⦈⦇F⦈"
        unfolding F_def A_def B_def
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp
  qed simp_all

  from assms(1-3) have
    "u ∘NTCF-CF g A↓CF 𝔎 : r <CF.cone 𝔗 ∘CF c' O⨅CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
    by (intro is_cat_coneI is_tm_ntcfI')
      (
        cs_concl
          cs_intro:
            cat_cs_intros
            cat_comma_cs_intros
            cat_lim_cs_intros
            cat_small_cs_intros
          cs_simp: const_r_def 𝔗c'𝔎
      )+
  with u'.cat_lim_unique_cone show
    "∃!G.
      G : r ↦𝔄 r' ∧
      u ∘NTCF-CF g A↓CF 𝔎 = u' ∙NTCF ntcf_const (c' ↓CF 𝔎) 𝔄 G"
    by simp

qed

lemma the_cf_rKe_ArrMap_app:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "g : c ↦ℭ c'"
    and "lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "lim_Obj c'⦇UArr⦈ :
      lim_Obj c'⦇UObj⦈ <CF.lim 𝔗 ∘CF c' O⨅CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
  shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ :
    lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
    and
      "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
        lim_Obj c'⦇UArr⦈ ∙NTCF
          ntcf_const (c' ↓CF 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈)"
    and 
      "⟦
        f : lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈;
        lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
          lim_Obj c'⦇UArr⦈ ∙NTCF ntcf_const (c' ↓CF 𝔎) 𝔄 f
       ⟧ ⟹ f = the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈"
proof-

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret u: is_cat_limit 
    α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹lim_Obj c⦇UObj⦈› ‹lim_Obj c⦇UArr⦈›
    by (rule assms(4))
  interpret u': is_cat_limit 
    α ‹c' ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c' O⨅CF 𝔎› ‹lim_Obj c'⦇UObj⦈› ‹lim_Obj c'⦇UArr⦈›
    by (rule assms(5))

  from assms(3) have c: "c ∈∘ ℭ⦇Obj⦈" and c': "c' ∈∘ ℭ⦇Obj⦈" by auto

  note the_cf_rKe_ArrMap_app_impl' =
    the_cf_rKe_ArrMap_app_impl[OF assms]
  note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
  note the_f_is_arr = the_f[THEN conjunct1]
    and the_f_commutes = the_f[THEN conjunct2]

  from assms(3) the_f_is_arr show
    "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ :
      lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
    by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
  moreover from assms(3) the_f_commutes show
    "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
      lim_Obj c'⦇UArr⦈ ∙NTCF
        ntcf_const (c' ↓CF 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈)"
    by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
  ultimately show "f = the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈"
    if "f : lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
      and "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF 𝔎 =
        lim_Obj c'⦇UArr⦈ ∙NTCF ntcf_const (c' ↓CF 𝔎) 𝔄 f"
    by (metis that the_cf_rKe_ArrMap_app_impl')

qed

lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "g : c ↦ℭ c'"
    and "lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "lim_Obj c'⦇UArr⦈ :
      lim_Obj c'⦇UObj⦈ <CF.lim 𝔗 ∘CF c' O⨅CF 𝔎 : c' ↓CF 𝔎 ↦↦Cα 𝔄"
    and "a = lim_Obj c⦇UObj⦈"
    and "b = lim_Obj c'⦇UObj⦈"
  shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ : a ↦𝔄 b"
  unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])

lemma lim_Obj_the_cf_rKe_commute:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "lim_Obj a⦇UArr⦈ :
      lim_Obj a⦇UObj⦈ <CF.lim 𝔗 ∘CF a O⨅CF 𝔎 : a ↓CF 𝔎 ↦↦Cα 𝔄"
    and "lim_Obj b⦇UArr⦈ :
      lim_Obj b⦇UObj⦈ <CF.lim 𝔗 ∘CF b O⨅CF 𝔎 : b ↓CF 𝔎 ↦↦Cα 𝔄"
    and "f : a ↦ℭ b"
    and "[a', b', f']∘ ∈∘ b ↓CF 𝔎⦇Obj⦈"
  shows  
    "lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘Aℭ f⦈∙ =
      lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈∙ ∘A𝔄
        the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈" 
proof-

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  note f = 𝔎.HomCod.cat_is_arrD[OF assms(5)]

  interpret lim_a: is_cat_limit
    α ‹a ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF a O⨅CF 𝔎› ‹lim_Obj a⦇UObj⦈› ‹lim_Obj a⦇UArr⦈›
    by (rule assms(3))
  interpret lim_b: is_cat_limit 
    α ‹b ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF b O⨅CF 𝔎› ‹lim_Obj b⦇UObj⦈› ‹lim_Obj b⦇UArr⦈› 
    by (rule assms(4))

  note f_app = the_cf_rKe_ArrMap_app[
      where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
      ]

  from f_app(2) have lim_a_f𝔎_NTMap_app:
    "(lim_Obj a⦇UArr⦈ ∘NTCF-CF f A↓CF 𝔎)⦇NTMap⦈⦇A⦈ =
      (
        lim_Obj b⦇UArr⦈ ∙NTCF
        ntcf_const (b ↓CF 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈)
      )⦇NTMap⦈⦇A⦈"
    if ‹A ∈∘ b ↓CF 𝔎⦇Obj⦈› for A
    by simp
  show 
    "lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘Aℭ f⦈∙ =
      lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈∙ ∘A𝔄
        the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈" 
  proof-
    from assms(5,6) have a'_def: "a' = 0"
      and b': "b' ∈∘ 𝔅⦇Obj⦈"
      and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
      by auto
    show 
      "lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘Aℭ f⦈∙ =
        lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈∙ ∘A𝔄
          the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈"
      using lim_a_f𝔎_NTMap_app[OF assms(6)] f' assms(3,4,5,6) 
      unfolding a'_def
      by
        (
          cs_prems
            cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
            cs_intro:
              cat_small_cs_intros
              cat_cs_intros
              cat_comma_cs_intros
              cat_Kan_cs_intros
        )      
  qed

qed


subsubsection‹Natural transformation: natural transformation map›

mk_VLambda the_ntcf_rKe_components(1)
  |vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda the_ntcf_rKe_components'(1)[OF 𝔎 𝔗]
  |vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|

end


subsubsection‹The Kan extension is a Kan extension›

lemma the_cf_rKe_is_functor:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
  shows "the_cf_rKe α 𝔗 𝔎 lim_Obj : ℭ ↦↦Cα 𝔄"
proof-

  let ?UObj = ‹λa. lim_Obj a⦇UObj⦈› 
  let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
  let ?const_comma = ‹λa b. cf_const (a ↓CF 𝔎) 𝔄 (?UObj b)›
  let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj
  
  show ?thesis
  proof(intro is_functorI')

    show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
    show "vcard ?the_cf_rKe = 4ℕ" 
      unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
    show "vsv (?the_cf_rKe⦇ObjMap⦈)" by (cs_concl cs_intro: cat_Kan_cs_intros)
    moreover show "𝒟∘ (?the_cf_rKe⦇ObjMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    moreover show "ℛ∘ (?the_cf_rKe⦇ObjMap⦈) ⊆∘ 𝔄⦇Obj⦈"
    proof
      (
        intro the_cf_rKe_ObjMap_vrange; 
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
      )
      fix c assume "c ∈∘ ℭ⦇Obj⦈"
      with assms(3)[OF this] show "?UObj c ∈∘ 𝔄⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
    qed
    ultimately have [cat_Kan_cs_intros]: 
      "?the_cf_rKe⦇ObjMap⦈⦇c⦈ ∈∘ 𝔄⦇Obj⦈" if ‹c ∈∘ ℭ⦇Obj⦈› for c
      by (metis that vsubsetE vsv.vsv_value)

    show "?the_cf_rKe⦇ArrMap⦈⦇f⦈ :
      ?the_cf_rKe⦇ObjMap⦈⦇a⦈ ↦𝔄 ?the_cf_rKe⦇ObjMap⦈⦇b⦈"
      if "f : a ↦ℭ b" for a b f
      using assms(2) that
      by 
        (
          cs_concl
            cs_simp: cat_Kan_cs_simps 
            cs_intro: 
              assms(3) cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros
        )
    then have [cat_Kan_cs_intros]: "?the_cf_rKe⦇ArrMap⦈⦇f⦈ : A ↦𝔄 B"
      if "A = ?the_cf_rKe⦇ObjMap⦈⦇a⦈" 
        and "B = ?the_cf_rKe⦇ObjMap⦈⦇b⦈"
        and "f : a ↦ℭ b" 
      for A B a b f
      by (simp add: that)

    show
      "?the_cf_rKe⦇ArrMap⦈⦇g ∘Aℭ f⦈ =
        ?the_cf_rKe⦇ArrMap⦈⦇g⦈ ∘A𝔄 ?the_cf_rKe⦇ArrMap⦈⦇f⦈"
      (is ‹?the_cf_rKe⦇ArrMap⦈⦇g ∘Aℭ f⦈ = ?the_rKe_g ∘A𝔄 ?the_rKe_f›)
      if g_is_arr: "g : b ↦ℭ c" and f_is_arr: "f : a ↦ℭ b" for b c g a f
    proof-

      let ?ntcf_const_c = ‹λf. ntcf_const (c ↓CF 𝔎) 𝔄 f›

      note g = 𝔎.HomCod.cat_is_arrD[OF that(1)]
        and f = 𝔎.HomCod.cat_is_arrD[OF that(2)]
      note lim_a = assms(3)[OF f(2)]
        and lim_b = assms(3)[OF g(2)]
        and lim_c = assms(3)[OF g(3)]
      from that have gf: "g ∘Aℭ f : a ↦ℭ c" 
        by (cs_concl cs_intro: cat_cs_intros)

      interpret lim_a: is_cat_limit
        α ‹a ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF a O⨅CF 𝔎› ‹?UObj a› ‹?UArr a›
        by (rule lim_a)
      interpret lim_c: is_cat_limit
        α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹?UObj c› ‹?UArr c›
        by (rule lim_c)

      show ?thesis
      proof
        (
          rule sym, 
          rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
        )

        from assms(1,2) that lim_a lim_b lim_c show 
          "?the_rKe_g ∘A𝔄 ?the_rKe_f : ?UObj a ↦𝔄 ?UObj c"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
            )
      
        show
          "?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎 = 
            ?UArr c ∙NTCF ?ntcf_const_c (?the_rKe_g ∘A𝔄 ?the_rKe_f)"
          (
            is 
              ‹
                ?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎 =
                  ?UArr c ∙NTCF ?ntcf_const_c ?the_rKe_gf
              ›
           )
        proof(rule ntcf_eqI)
          from that show 
            "?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎 :
              cf_const (a ↓CF 𝔎) 𝔄 (?UObj a) ∘CF (g ∘Aℭ f) A↓CF 𝔎 ↦CF
              𝔗 ∘CF a O⨅CF 𝔎 ∘CF ((g ∘Aℭ f) A↓CF 𝔎) :
              c ↓CF 𝔎 ↦↦Cα 𝔄"
            by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
          have [cat_comma_cs_simps]: 
            "?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎 = ?const_comma c a"
          proof(rule cf_eqI)
            from g_is_arr f_is_arr show
              "?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps
                    cs_intro: 
                      cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                )
            from g_is_arr f_is_arr show "?const_comma c a : c ↓CF 𝔎 ↦↦Cα 𝔄"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps
                    cs_intro: 
                      cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                )
            from g_is_arr f_is_arr have ObjMap_dom_lhs:
              "𝒟∘ ((?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ObjMap⦈) =
                c ↓CF 𝔎⦇Obj⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps 
                    cs_intro: 
                      cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                )
            from g_is_arr f_is_arr have ObjMap_dom_rhs:
              "𝒟∘ (?const_comma c a⦇ObjMap⦈) = c ↓CF 𝔎⦇Obj⦈"
              by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)

            show
              "(?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ObjMap⦈ =
                ?const_comma c a⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
              from f_is_arr g_is_arr show 
                "vsv ((?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ObjMap⦈)"
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
              fix A assume prems: "A ∈∘ c ↓CF 𝔎⦇Obj⦈"
              with g_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                by auto
              from prems b' f' g_is_arr f_is_arr show 
                "(?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ObjMap⦈⦇A⦈ =
                  ?const_comma c a⦇ObjMap⦈⦇A⦈"
                unfolding A_def
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
            qed (cs_concl cs_intro: cat_cs_intros)

            from g_is_arr f_is_arr have ArrMap_dom_lhs:
              "𝒟∘ ((?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ArrMap⦈) = 
                c ↓CF 𝔎⦇Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps 
                    cs_intro: 
                      cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                )
            from g_is_arr f_is_arr have ArrMap_dom_rhs:
              "𝒟∘ (?const_comma c a⦇ArrMap⦈) = c ↓CF 𝔎⦇Arr⦈"
              by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)

            show 
              "(?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ArrMap⦈ =
                ?const_comma c a⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              from f_is_arr g_is_arr show
                "vsv ((?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ArrMap⦈)"
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
              fix F assume "F ∈∘ c ↓CF 𝔎⦇Arr⦈"
              then obtain A B where F: "F : A ↦c ↓CF 𝔎 B"
                unfolding cat_comma_cs_simps by (auto intro: is_arrI)
              with g_is_arr obtain b' f' b'' f'' h'
                where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h']∘]∘"
                  and A_def: "A = [0, b', f']∘"
                  and B_def: "B = [0, b'', f'']∘"
                  and h': "h' : b' ↦𝔅 b''"
                  and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                  and f'': "f'' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b''⦈"
                  and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f' = f''"
                by auto
              from F f_is_arr g_is_arr g' h' f' f'' show 
                "(?const_comma a a ∘CF (g ∘Aℭ f) A↓CF 𝔎)⦇ArrMap⦈⦇F⦈ =
                  ?const_comma c a⦇ArrMap⦈⦇F⦈"
                unfolding F_def A_def B_def
                by
                  (
                    cs_concl
                      cs_intro:
                        cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
                      cs_simp: 
                        cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                  )
            qed (cs_concl cs_intro: cat_cs_intros)
          qed simp_all

          from that show
            "?UArr c ∙NTCF ?ntcf_const_c ?the_rKe_gf :
              cf_const (a ↓CF 𝔎) 𝔄 (?UObj a) ∘CF (g ∘Aℭ f) A↓CF 𝔎 ↦CF
              𝔗 ∘CF a O⨅CF 𝔎 ∘CF ((g ∘Aℭ f) A↓CF 𝔎) :
              c ↓CF 𝔎 ↦↦Cα 𝔄"
            by
              (
                cs_concl
                  cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps 
                  cs_intro: cat_comma_cs_intros cat_Kan_cs_intros cat_cs_intros
              )
          from that have dom_lhs:
            "𝒟∘ ((?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎)⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_cs_intros cat_comma_cs_intros
                  cs_simp: cat_cs_simps cat_comma_cs_simps
              )
          from that have dom_rhs: 
            "𝒟∘ ((?UArr c ∙NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈) = 
              c ↓CF 𝔎⦇Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                  cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
              )
          show 
            "(?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎)⦇NTMap⦈ =
              (?UArr c ∙NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
            fix A assume prems: "A ∈∘ c ↓CF 𝔎⦇Obj⦈"
            with g_is_arr obtain b' f' 
              where A_def: "A = [0, b', f']∘"
                and b': "b' ∈∘ 𝔅⦇Obj⦈"
                and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
              by auto
            note 𝔗.HomCod.cat_Comp_assoc[cat_cs_simps del]
              and 𝔎.HomCod.cat_Comp_assoc[cat_cs_simps del]
              and category.cat_Comp_assoc[cat_cs_simps del]
            note [symmetric, cat_cs_simps] =
              lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
              𝔎.HomCod.cat_Comp_assoc  
              𝔗.HomCod.cat_Comp_assoc
            from assms(1,2) that prems lim_a lim_b lim_c b' f' show
              "(?UArr a ∘NTCF-CF (g ∘Aℭ f) A↓CF 𝔎)⦇NTMap⦈⦇A⦈ =
                (?UArr c ∙NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈⦇A⦈"
              unfolding A_def
              by (*very slow*)
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps 
                    cs_intro: 
                      cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                )+
          qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
        qed simp_all
      qed
    qed
    
    show "?the_cf_rKe⦇ArrMap⦈⦇ℭ⦇CId⦈⦇c⦈⦈ = 𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ ℭ⦇Obj⦈" for c
    proof-

      let ?ntcf_const_c = ‹ntcf_const (c ↓CF 𝔎) 𝔄 (𝔄⦇CId⦈⦇?UObj c⦈)›

      note lim_c = assms(3)[OF that]

      from that have CId_c: "ℭ⦇CId⦈⦇c⦈ : c ↦ℭ c" 
        by (cs_concl cs_intro: cat_cs_intros)

      interpret lim_c: is_cat_limit 
        α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹?UObj c› ‹?UArr c›
        by (rule lim_c)

      show ?thesis
      proof
        (
          rule sym,
          rule the_cf_rKe_ArrMap_app(3)[
            where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
            ]
        )
        from that lim_c show 
          "𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈ : ?UObj c ↦𝔄 ?UObj c"
          by 
            (
              cs_concl
                cs_simp: cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_lim_cs_intros
            )
        have "?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 =  ?UArr c ∙NTCF ?ntcf_const_c"
        proof(rule ntcf_eqI)
          from lim_c that show 
            "?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 :
              cf_const (c ↓CF 𝔎) 𝔄 (?UObj c) ∘CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 ↦CF
              𝔗 ∘CF c O⨅CF 𝔎 ∘CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 :
              c ↓CF 𝔎 ↦↦Cα 𝔄"
            by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
          from lim_c that show 
            "?UArr c ∙NTCF ?ntcf_const_c :
               cf_const (c ↓CF 𝔎) 𝔄 (?UObj c) ∘CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 ↦CF
               𝔗 ∘CF c O⨅CF 𝔎 ∘CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 :
               c ↓CF 𝔎 ↦↦Cα 𝔄"
            by 
              (
                cs_concl 
                  cs_intro: cat_cs_intros cat_lim_cs_intros 
                  cs_simp: 𝔎.cf_cf_arr_comma_CId cat_cs_simps
              )
          from that have dom_lhs:
            "𝒟∘ ((?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎)⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps 
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
          from that have dom_rhs:
            "𝒟∘ ((?UArr c ∙NTCF ?ntcf_const_c)⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_lim_cs_intros cat_cs_intros 
                  cs_simp: cat_cs_simps
              )
          show 
            "(?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎)⦇NTMap⦈ =
              (?UArr c ∙NTCF ?ntcf_const_c)⦇NTMap⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
            fix A assume prems: "A ∈∘ c ↓CF 𝔎⦇Obj⦈"
            with that obtain b f 
              where A_def: "A = [0, b, f]∘"
                and b: "b ∈∘ 𝔅⦇Obj⦈" 
                and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
              by auto
            from that prems f have 
              "?UArr c⦇NTMap⦈⦇0, b, f⦈∙ : ?UObj c ↦𝔄 𝔗⦇ObjMap⦈⦇b⦈"
              unfolding A_def
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps 
                    cs_intro: cat_comma_cs_intros cat_cs_intros
                )
            from that prems f show 
              "(?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎)⦇NTMap⦈⦇A⦈ =
                (?UArr c ∙NTCF ?ntcf_const_c)⦇NTMap⦈⦇A⦈"
              unfolding A_def 
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps
                    cs_intro: 
                      cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
                )
          qed (cs_concl cs_intro: cat_cs_intros)
        qed simp_all

        with that show 
          "?UArr c ∘NTCF-CF (ℭ⦇CId⦈⦇c⦈) A↓CF 𝔎 = 
            ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 (𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈)"
          by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)

      qed

    qed

  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma the_ntcf_rKe_is_ntcf:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ" 
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ : 
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
  shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj :
    the_cf_rKe α 𝔗 𝔎 lim_Obj ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"
proof-

  let ?UObj = ‹λa. lim_Obj a⦇UObj⦈› 
  let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
  let ?const_comma = ‹λa b. cf_const (a ↓CF 𝔎) 𝔄 (?UObj b)›
  let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›
  let ?the_ntcf_rKe = ‹the_ntcf_rKe α 𝔗 𝔎 lim_Obj›

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret cf_rKe: is_functor α ℭ 𝔄 ‹?the_cf_rKe›
    by (rule the_cf_rKe_is_functor[OF assms, simplified])

  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
    show "vcard ?the_ntcf_rKe = 5ℕ"
      unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
    show "?the_ntcf_rKe⦇NTMap⦈⦇b⦈ : 
      (?the_cf_rKe ∘CF 𝔎)⦇ObjMap⦈⦇b⦈ ↦𝔄 𝔗⦇ObjMap⦈⦇b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      let ?𝔎b = ‹𝔎⦇ObjMap⦈⦇b⦈›
      from that have 𝔎b: "𝔎⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈"
        by (cs_concl cs_intro: cat_cs_intros)
      note lim_𝔎b = assms(3)[OF 𝔎b]
      interpret lim_𝔎b: is_cat_limit 
        α ‹?𝔎b ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF ?𝔎b O⨅CF 𝔎› ‹?UObj ?𝔎b› ‹?UArr ?𝔎b›
        by (rule lim_𝔎b)
      from that lim_𝔎b show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
          )+
    qed
    show 
      "?the_ntcf_rKe⦇NTMap⦈⦇b⦈ ∘A𝔄 (?the_cf_rKe ∘CF 𝔎)⦇ArrMap⦈⦇f⦈ =
        𝔗⦇ArrMap⦈⦇f⦈ ∘A𝔄 ?the_ntcf_rKe⦇NTMap⦈⦇a⦈"
      if "f : a ↦𝔅 b" for a b f 
    proof-
      let ?𝔎a = ‹𝔎⦇ObjMap⦈⦇a⦈› and ?𝔎b = ‹𝔎⦇ObjMap⦈⦇b⦈› and ?𝔎f = ‹𝔎⦇ArrMap⦈⦇f⦈›
      from that have 𝔎a: "?𝔎a ∈∘ ℭ⦇Obj⦈" 
        and 𝔎b: "?𝔎b ∈∘ ℭ⦇Obj⦈"
        and 𝔎f: "?𝔎f : ?𝔎a ↦ℭ ?𝔎b"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
      note lim_𝔎a = assms(3)[OF 𝔎a]
        and lim_𝔎b = assms(3)[OF 𝔎b]
      from that have z_b_𝔎b: "[0, b, ℭ⦇CId⦈⦇?𝔎b⦈]∘ ∈∘ ?𝔎b ↓CF 𝔎⦇Obj⦈"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      from 
        lim_Obj_the_cf_rKe_commute[
          OF assms(1,2) lim_𝔎a lim_𝔎b 𝔎f z_b_𝔎b, symmetric
          ]
        that
      have [cat_Kan_cs_simps]:
        "?UArr ?𝔎b⦇NTMap⦈⦇0, b, ℭ⦇CId⦈⦇?𝔎b⦈⦈∙ ∘A𝔄 ?the_cf_rKe⦇ArrMap⦈⦇?𝔎f⦈ =
          ?UArr ?𝔎a⦇NTMap⦈⦇0, b, ?𝔎f⦈∙"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      interpret lim_𝔎a: is_cat_limit
        α ‹?𝔎a ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF ?𝔎a O⨅CF 𝔎› ‹?UObj ?𝔎a› ‹?UArr ?𝔎a›
        by (rule lim_𝔎a)
      interpret lim_𝔎b: is_cat_limit 
        α ‹?𝔎b ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF ?𝔎b O⨅CF 𝔎› ‹?UObj ?𝔎b› ‹?UArr ?𝔎b›
        by (rule lim_𝔎b)
      from that have 
        "[[0, a, ℭ⦇CId⦈⦇?𝔎a⦈]∘, [0, b, ?𝔎f]∘, [0, f]∘]∘ :
          [0, a, ℭ⦇CId⦈⦇?𝔎a⦈]∘ ↦(?𝔎a) ↓CF 𝔎 [0, b, ?𝔎f]∘"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from lim_𝔎a.ntcf_Comp_commute[OF this, symmetric] that
      have [cat_Kan_cs_simps]:
        "𝔗⦇ArrMap⦈⦇f⦈ ∘A𝔄 ?UArr (?𝔎a)⦇NTMap⦈ ⦇0, a, ℭ⦇CId⦈⦇?𝔎a⦈⦈∙ =
          ?UArr ?𝔎a⦇NTMap⦈⦇0, b, ?𝔎f⦈∙"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros 𝒵.cat_1_is_arrI
          )
      from that show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )
    qed
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma the_ntcf_rKe_is_cat_rKe:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "⋀c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
  shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj :
    the_cf_rKe α 𝔗 𝔎 lim_Obj ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C ℭ ↦C 𝔄"
proof-

  let ?UObj = ‹λa. lim_Obj a⦇UObj⦈› 
  let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
  let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›
  let ?the_ntcf_rKe = ‹the_ntcf_rKe α 𝔗 𝔎 lim_Obj›

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret cf_rKe: is_functor α ℭ 𝔄 ?the_cf_rKe
    by (rule the_cf_rKe_is_functor[OF assms, simplified])
  interpret ntcf_rKe: is_ntcf α 𝔅 𝔄 ‹?the_cf_rKe ∘CF 𝔎› 𝔗 ?the_ntcf_rKe
    by (intro the_ntcf_rKe_is_ntcf assms(3))
      (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)+

  show ?thesis
  proof(rule is_cat_rKeI')

    fix 𝔊 ε assume prems: 
      "𝔊 : ℭ ↦↦Cα 𝔄" "ε : 𝔊 ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"

    interpret 𝔊: is_functor α ℭ 𝔄 𝔊 by (rule prems(1))
    interpret ε: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘CF 𝔎› 𝔗 ε by (rule prems(2))

    define ε' where "ε' c =
      [
        (λA∈∘c ↓CF 𝔎⦇Obj⦈. ε⦇NTMap⦈⦇A⦇1ℕ⦈⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇A⦇2ℕ⦈⦈),
        cf_const (c ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈),
        𝔗 ∘CF c O⨅CF 𝔎,
        c ↓CF 𝔎,
        𝔄
      ]∘"
      for c

    have ε'_components: 
      "ε' c⦇NTMap⦈ = (λA∈∘c ↓CF 𝔎⦇Obj⦈. ε⦇NTMap⦈⦇A⦇1ℕ⦈⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇A⦇2ℕ⦈⦈)"
      "ε' c⦇NTDom⦈ = cf_const (c ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)"
      "ε' c⦇NTCod⦈ = 𝔗 ∘CF c O⨅CF 𝔎"
      "ε' c⦇NTDGDom⦈ = c ↓CF 𝔎"
      "ε' c⦇NTDGCod⦈ = 𝔄"
      for c 
      unfolding ε'_def nt_field_simps by (simp_all add: nat_omega_simps)
    note [cat_Kan_cs_simps] = ε'_components(2-5)
    have [cat_Kan_cs_simps]: "ε' c⦇NTMap⦈⦇A⦈ = ε⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈"
      if "A = [a, b, f]∘" and "[a, b, f]∘ ∈∘ c ↓CF 𝔎⦇Obj⦈" for A a b c f
      using that unfolding ε'_components by (auto simp: nat_omega_simps)

    have ε': "ε' c : 𝔊⦇ObjMap⦈⦇c⦈ <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
      and ε'_unique: "∃!f'.
        f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
        ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f'" 
      if c: "c ∈∘ ℭ⦇Obj⦈" for c
    proof-
      from that have "?the_cf_rKe⦇ObjMap⦈⦇c⦈ = ?UObj c"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
      interpret lim_c: is_cat_limit 
        α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹?UObj c› ‹?UArr c›
        by (rule assms(3)[OF that])
      show "ε' c : 𝔊⦇ObjMap⦈⦇c⦈ <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
      proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
        show "vfsequence (ε' c)" unfolding ε'_def by simp
        show "vcard (ε' c) = 5ℕ" unfolding ε'_def by (simp add: nat_omega_simps)
        show "vsv (ε' c⦇NTMap⦈)" unfolding ε'_components by simp 
        show "𝒟∘ (ε' c⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈" unfolding ε'_components by simp
        show "ε' c⦇NTMap⦈⦇A⦈ :
          cf_const (c ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)⦇ObjMap⦈⦇A⦈ ↦𝔄
          (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇A⦈"
          if "A ∈∘ c ↓CF 𝔎⦇Obj⦈" for A
        proof-
          from that prems c obtain b f 
            where A_def: "A = [0, b, f]∘"
              and b: "b ∈∘ 𝔅⦇Obj⦈" 
              and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
            by auto
          from that prems f c that b f show ?thesis
            unfolding A_def
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed
        show
          "ε' c⦇NTMap⦈⦇B⦈ ∘A𝔄 cf_const (c ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)⦇ArrMap⦈⦇F⦈ =
            (𝔗 ∘CF c O⨅CF 𝔎)⦇ArrMap⦈⦇F⦈ ∘A𝔄 ε' c⦇NTMap⦈⦇A⦈"
          if "F : A ↦c ↓CF 𝔎 B" for A B F
        proof-
          from that c 
          obtain b f b' f' k 
            where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, k]∘]∘"
              and A_def: "A = [0, b, f]∘"
              and B_def: "B = [0, b', f']∘"
              and k: "k : b ↦𝔅 b'"
              and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
              and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
              and f'_def: "𝔎⦇ArrMap⦈⦇k⦈ ∘Aℭ f = f'"
            by auto
          from c that k f f' show ?thesis
            unfolding F_def A_def B_def
            by (*slow*)
              (
                cs_concl
                  cs_simp:
                    cat_cs_simps
                    cat_comma_cs_simps
                    cat_Kan_cs_simps
                    ε.ntcf_Comp_commute''
                    f'_def[symmetric]
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed
      qed
        (
          use c that in
            ‹
              cs_concl
                cs_simp: cat_Kan_cs_simps
                cs_intro: cat_small_cs_intros cat_cs_intros
            ›
        )+
      from is_cat_limit.cat_lim_unique_cone[OF assms(3)[OF that] this] show 
        "∃!f'.
          f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
          ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f'"  
        by simp
    qed

    define σ :: V where
      "σ =
        [
          (
            λc∈∘ℭ⦇Obj⦈. THE f.
              f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
              ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f
          ),
          𝔊,
          ?the_cf_rKe,
          ℭ,
          𝔄
        ]∘"

    have σ_components:
      "σ⦇NTMap⦈ =
        (
          λc∈∘ℭ⦇Obj⦈. THE f.
            f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
            ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f
        )"
      "σ⦇NTDom⦈ = 𝔊"
      "σ⦇NTCod⦈ = ?the_cf_rKe"
      "σ⦇NTDGDom⦈ = ℭ"
      "σ⦇NTDGCod⦈ = 𝔄"
      unfolding σ_def nt_field_simps by (simp_all add: nat_omega_simps)

    note [cat_Kan_cs_simps] = σ_components(2-5)

    have σ_NTMap_app_def: "σ⦇NTMap⦈⦇c⦈ =
      (
        THE f.
          f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
          ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f
      )"
      if "c ∈∘ ℭ⦇Obj⦈" for c
      using that unfolding σ_components by simp

    have σ_NTMap_app_is_arr: "σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c"
      and ε'_σ_commute:
        "ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
      and σ_NTMap_app_unique:
        "⟦
          f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c;
          ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f
         ⟧ ⟹ f = σ⦇NTMap⦈⦇c⦈"
        if c: "c ∈∘ ℭ⦇Obj⦈" for c f
    proof-
      have 
        "σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c ∧
        ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
        by 
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps σ_NTMap_app_def 
              cs_intro: theI' ε'_unique that
          )
      then show "σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c"
        and "ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
        by simp_all
      with c ε'_unique[OF c] show "f = σ⦇NTMap⦈⦇c⦈"
        if "f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c"
          and "ε' c = ?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 f"
        using that by metis
    qed

    have σ_NTMap_app_is_arr'[cat_Kan_cs_intros]: "σ⦇NTMap⦈⦇c⦈ : a ↦𝔄' b"
      if "c ∈∘ ℭ⦇Obj⦈" 
        and "a = 𝔊⦇ObjMap⦈⦇c⦈" 
        and "b = ?UObj c" 
        and "𝔄' = 𝔄"
      for 𝔄' a b c
      by (simp add: that σ_NTMap_app_is_arr)

    have ε'_NTMap_app_def: 
      "ε' c⦇NTMap⦈⦇A⦈ =
        (?UArr c ∙NTCF ntcf_const (c ↓CF 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈))⦇NTMap⦈⦇A⦈"
      if "A ∈∘ c ↓CF 𝔎⦇Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" for A c
      using ε'_σ_commute[OF that(2)] by simp
    have εb_𝔊f:
      "ε⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈ =
        ?UArr c⦇NTMap⦈⦇a, b, f⦈∙ ∘A𝔄 σ⦇NTMap⦈⦇c⦈"
      if "A = [a, b, f]∘" and "A ∈∘ c ↓CF 𝔎⦇Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" 
      for A a b c f
    proof-
      interpret lim_c: is_cat_limit 
        α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹?UObj c› ‹?UArr c›
        by (rule assms(3)[OF that(3)])
      from that have b: "b ∈∘ 𝔅⦇Obj⦈" and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
        by blast+
      show
        "ε⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈ =
          ?UArr c⦇NTMap⦈⦇a, b, f⦈∙ ∘A𝔄 σ⦇NTMap⦈⦇c⦈"
        using ε'_NTMap_app_def[OF that(2,3)] that(2,3)
        unfolding that(1)
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros cat_Kan_cs_intros
          )
    qed

    show "∃!σ.
      σ : 𝔊 ↦CF ?the_cf_rKe : ℭ ↦↦Cα 𝔄 ∧
      ε = ?the_ntcf_rKe ∙NTCF (σ ∘NTCF-CF 𝔎)"
    proof(intro ex1I[where a=σ] conjI; (elim conjE)?)

      define τ where "τ a b f =
        [
          (
            λF∈∘b ↓CF 𝔎⦇Obj⦈.
              ?UArr b⦇NTMap⦈⦇F⦈ ∘A𝔄 σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈
          ),
          cf_const (b ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈),
          𝔗 ∘CF b O⨅CF 𝔎,
          b ↓CF 𝔎,
          𝔄
        ]∘"
        for a b f

      have τ_components:
        "τ a b f⦇NTMap⦈ =
          (
            λF∈∘b ↓CF 𝔎⦇Obj⦈.
              ?UArr b⦇NTMap⦈⦇F⦈ ∘A𝔄 σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈
          )"
        "τ a b f⦇NTDom⦈ = cf_const (b ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)"
        "τ a b f⦇NTCod⦈ = 𝔗 ∘CF b O⨅CF 𝔎"
        "τ a b f⦇NTDGDom⦈ = b ↓CF 𝔎"
        "τ a b f⦇NTDGCod⦈ = 𝔄"
        for a b f
        unfolding τ_def nt_field_simps by (simp_all add: nat_omega_simps)
      note [cat_Kan_cs_simps] = τ_components(2-5)
      have τ_NTMap_app[cat_Kan_cs_simps]: 
        "τ a b f⦇NTMap⦈⦇F⦈ =
          ?UArr b⦇NTMap⦈⦇F⦈ ∘A𝔄 σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈"
        if "F ∈∘ b ↓CF 𝔎⦇Obj⦈" for a b f F
        using that unfolding τ_components by auto
      
      have τ: "τ a b f :
        𝔊⦇ObjMap⦈⦇a⦈ <CF.cone 𝔗 ∘CF b O⨅CF 𝔎 : b ↓CF 𝔎 ↦↦Cα 𝔄"
        if f_is_arr: "f : a ↦ℭ b" for a b f
      proof-

        note f = 𝔎.HomCod.cat_is_arrD[OF that]
        note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

        interpret lim_b: is_cat_limit 
          α ‹b ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF b O⨅CF 𝔎› ‹?UObj b› ‹?UArr b›
          by (rule lim_b)
        
        from f have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto

        show ?thesis
        proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')

          show "vfsequence (τ a b f)" unfolding τ_def by simp
          show "vcard (τ a b f) = 5ℕ" 
            unfolding τ_def by (simp add: nat_omega_simps)
          show "vsv (τ a b f⦇NTMap⦈)" unfolding τ_components by auto
          show "𝒟∘ (τ a b f⦇NTMap⦈) = b ↓CF 𝔎⦇Obj⦈" by (auto simp: τ_components)
          show "τ a b f⦇NTMap⦈⦇A⦈ :
            cf_const (b ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)⦇ObjMap⦈⦇A⦈ ↦𝔄
            (𝔗 ∘CF b O⨅CF 𝔎)⦇ObjMap⦈⦇A⦈"
            if "A ∈∘ b ↓CF 𝔎⦇Obj⦈" for A
          proof-
            from that f_is_arr obtain b' f' 
              where A_def: "A = [0, b', f']∘"
                and b': "b' ∈∘ 𝔅⦇Obj⦈"
                and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
              by auto
            from  f_is_arr that b' f' a b show ?thesis
              unfolding A_def
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                    cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                )   
          qed
          show
            "τ a b f⦇NTMap⦈⦇B⦈ ∘A𝔄
              cf_const (b ↓CF 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)⦇ArrMap⦈⦇F⦈ =
              (𝔗 ∘CF b O⨅CF 𝔎)⦇ArrMap⦈⦇F⦈ ∘A𝔄 τ a b f⦇NTMap⦈⦇A⦈"
            if "F : A ↦b ↓CF 𝔎 B" for A B F
          proof-
            from that have F: "F : A ↦b ↓CF 𝔎 B"
              by (auto intro: is_arrI)
            with f_is_arr obtain b' f' b'' f'' h'
              where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h']∘]∘"
                and A_def: "A = [0, b', f']∘"
                and B_def: "B = [0, b'', f'']∘"
                and h': "h' : b' ↦𝔅 b''"
                and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                and f'': "f'' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b''⦈"
                and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f' = f''"
              by auto
            from
              lim_b.ntcf_Comp_commute[OF that] 
              that f_is_arr g' h' f' f'' 
            have [cat_Kan_cs_simps]:
              "?UArr b⦇NTMap⦈⦇0, b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f'⦈∙ =
                𝔗⦇ArrMap⦈⦇h'⦈ ∘A𝔄 ?UArr b⦇NTMap⦈⦇0, b', f'⦈∙"
              unfolding F_def A_def B_def
              by
                (
                  cs_prems
                    cs_simp: 
                      cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                    cs_intro: cat_cs_intros cat_comma_cs_intros
                )
            from f_is_arr that g' h' f' f'' show ?thesis
              unfolding F_def A_def B_def (*very slow*)
              by
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps 
                      cat_Kan_cs_simps 
                      cat_comma_cs_simps 
                      f''_def[symmetric]
                    cs_intro:
                      cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                )+
          qed

        qed
          (
            use that f_is_arr in
              ‹
                cs_concl
                  cs_simp: cat_cs_simps cat_Kan_cs_simps
                  cs_intro: cat_small_cs_intros cat_cs_intros
              ›
          )+
      qed

      show σ: "σ : 𝔊 ↦CF ?the_cf_rKe : ℭ ↦↦Cα 𝔄"
      proof(rule is_ntcfI')

        show "vfsequence σ" unfolding σ_def by simp
        show "vcard σ = 5ℕ" unfolding σ_def by (simp add: nat_omega_simps)
        show "vsv (σ⦇NTMap⦈)" unfolding σ_components by auto
        show "𝒟∘ (σ⦇NTMap⦈) = ℭ⦇Obj⦈" unfolding σ_components by simp
        show "σ⦇NTMap⦈⦇a⦈ : 𝔊⦇ObjMap⦈⦇a⦈ ↦𝔄 ?the_cf_rKe⦇ObjMap⦈⦇a⦈"
          if "a ∈∘ ℭ⦇Obj⦈" for a
          using that 
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_Kan_cs_intros
            )

        then have [cat_Kan_cs_intros]: "σ⦇NTMap⦈⦇a⦈ : b ↦𝔄 c"
          if "a ∈∘ ℭ⦇Obj⦈" 
            and "b = 𝔊⦇ObjMap⦈⦇a⦈" 
            and "c = ?the_cf_rKe⦇ObjMap⦈⦇a⦈"
          for a b c
          using that(1) unfolding that(2,3) by simp

        show 
          "σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈ =
            ?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘A𝔄 σ⦇NTMap⦈⦇a⦈"
          if f_is_arr: "f : a ↦ℭ b" for a b f
        proof-

          note f = 𝔎.HomCod.cat_is_arrD[OF that]
          note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

          interpret lim_a: is_cat_limit 
            α ‹a ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF a O⨅CF 𝔎› ‹?UObj a› ‹?UArr a›
            by (rule lim_a)
          interpret lim_b: is_cat_limit 
            α ‹b ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF b O⨅CF 𝔎› ‹?UObj b› ‹?UArr b›
            by (rule lim_b)

          from f have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto
          
          from lim_b.cat_lim_unique_cone'[OF τ[OF that]] obtain g' 
            where g': "g' : 𝔊⦇ObjMap⦈⦇a⦈ ↦𝔄 ?UObj b"
              and τ_NTMap_app: "⋀A. A ∈∘ (b ↓CF 𝔎⦇Obj⦈) ⟹
                τ a b f⦇NTMap⦈⦇A⦈ = ?UArr b⦇NTMap⦈⦇A⦈ ∘A𝔄 g'"
              and g'_unique: "⋀g''.
                ⟦
                  g'' : 𝔊⦇ObjMap⦈⦇a⦈ ↦𝔄 ?UObj b;
                  ⋀A. A ∈∘ b ↓CF 𝔎⦇Obj⦈ ⟹
                    τ a b f⦇NTMap⦈⦇A⦈ = ?UArr b⦇NTMap⦈⦇A⦈ ∘A𝔄 g''
                ⟧ ⟹ g'' = g'"
            by metis

          have lim_Obj_a_f𝔎[symmetric, cat_Kan_cs_simps]:
            "?UArr a⦇NTMap⦈⦇a', b', f' ∘Aℭ f⦈∙ =
              ?UArr b⦇NTMap⦈⦇A⦈ ∘A𝔄 ?the_cf_rKe⦇ArrMap⦈⦇f⦈"
            if "A = [a', b', f']∘" and "A ∈∘ b ↓CF 𝔎⦇Obj⦈" for A a' b' f'
          proof-
            from that(2) f_is_arr have a'_def: "a' = 0" 
              and b': "b' ∈∘ 𝔅⦇Obj⦈" 
              and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
              unfolding that(1) by auto
            show ?thesis 
              unfolding that(1) 
              by 
                (
                  rule 
                    lim_Obj_the_cf_rKe_commute
                      [
                        where lim_Obj=lim_Obj, 
                        OF 
                          assms(1,2) 
                          lim_a 
                          lim_b 
                          f_is_arr 
                          that(2)[unfolded that(1)] 
                      ]
                )
          qed
          {
            fix a' b' f' A
            note 𝔗.HomCod.cat_assoc_helper[
              where h=‹?UArr b⦇NTMap⦈⦇a',b',f'⦈∙› 
                and g=‹?the_cf_rKe⦇ArrMap⦈⦇f⦈›
                and q=‹?UArr a⦇NTMap⦈⦇a', b', f' ∘Aℭ f⦈∙›
                ]
          }
          note [cat_Kan_cs_simps] = this

          show ?thesis
          proof(rule trans_sym[where s=g'])
            show "σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈ = g'"
            proof(rule g'_unique)
              from that show
                "σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈ : 𝔊⦇ObjMap⦈⦇a⦈ ↦𝔄 ?UObj b"
                by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
              fix A assume prems': "A ∈∘ b ↓CF 𝔎⦇Obj⦈"
              with f_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                by auto
              from f_is_arr prems' show
                "τ a b f⦇NTMap⦈⦇A⦈ =
                  ?UArr b⦇NTMap⦈⦇A⦈ ∘A𝔄 (σ⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f⦈)"
                unfolding A_def
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps
                      cs_intro: cat_cs_intros cat_Kan_cs_intros
                  )
            qed
            show "?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘A𝔄 σ⦇NTMap⦈⦇a⦈ = g'"
            proof(rule g'_unique)                  
              fix A assume prems': "A ∈∘ b ↓CF 𝔎⦇Obj⦈"
              with f_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : b ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                by auto
              {
                fix a' b' f' A
                note 𝔗.HomCod.cat_assoc_helper
                  [
                    where h=‹?UArr b⦇NTMap⦈⦇a', b', f'⦈∙› 
                      and g=‹σ⦇NTMap⦈⦇b⦈›
                      and q=‹ε⦇NTMap⦈⦇b'⦈ ∘A𝔄 𝔊⦇ArrMap⦈⦇f'⦈›
                  ]
              }
              note [cat_Kan_cs_simps] = 
                this
                εb_𝔊f[OF A_def prems' b, symmetric]
                εb_𝔊f[symmetric]
              from f_is_arr prems' b' f' show 
                "τ a b f⦇NTMap⦈⦇A⦈ =
                  ?UArr b⦇NTMap⦈⦇A⦈ ∘A𝔄
                    (?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘A𝔄 σ⦇NTMap⦈⦇a⦈)"
                unfolding A_def
                by
                  (
                    cs_concl 
                      cs_simp: 
                        cat_cs_simps 
                        cat_Kan_cs_simps 
                        cat_comma_cs_simps
                        cat_op_simps
                      cs_intro: 
                        cat_cs_intros 
                        cat_Kan_cs_intros 
                        cat_comma_cs_intros 
                        cat_op_intros
                  )
            qed
              (
                use that in
                  ‹
                    cs_concl
                      cs_simp: cat_Kan_cs_simps
                      cs_intro: cat_cs_intros cat_Kan_cs_intros
                  ›
              )
          qed
        qed
      qed
        (
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps
            cs_intro: cat_cs_intros
        )+
      then interpret σ: is_ntcf α ℭ 𝔄 𝔊 ‹?the_cf_rKe› σ by simp

      show "ε = ?the_ntcf_rKe ∙NTCF (σ ∘NTCF-CF 𝔎)"
      proof(rule ntcf_eqI)
        have dom_lhs: "𝒟∘ (ε⦇NTMap⦈) = 𝔅⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        have dom_rhs: "𝒟∘ ((?the_ntcf_rKe ∙NTCF (σ ∘NTCF-CF 𝔎))⦇NTMap⦈) = 𝔅⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "ε⦇NTMap⦈ = (?the_ntcf_rKe ∙NTCF (σ ∘NTCF-CF 𝔎))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix b assume prems': "b ∈∘ 𝔅⦇Obj⦈"
          note [cat_Kan_cs_simps] = εb_𝔊f[
            where f=‹ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b⦈⦈› and c=‹𝔎⦇ObjMap⦈⦇b⦈›, symmetric
            ]
          from prems' σ show 
            "ε⦇NTMap⦈⦇b⦈ = (?the_ntcf_rKe ∙NTCF (σ ∘NTCF-CF 𝔎))⦇NTMap⦈⦇b⦈"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                  cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
              )
        qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
      qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

      fix σ' assume prems':
        "σ' : 𝔊 ↦CF ?the_cf_rKe : ℭ ↦↦Cα 𝔄"
        "ε = ?the_ntcf_rKe ∙NTCF (σ' ∘NTCF-CF 𝔎)"

      interpret σ': is_ntcf α ℭ 𝔄 𝔊 ‹?the_cf_rKe› σ' by (rule prems'(1))

      have ε_NTMap_app[symmetric, cat_Kan_cs_simps]: 
        "ε⦇NTMap⦈⦇b'⦈ =
          ?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈⦈∙ ∘A𝔄
          σ'⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈"
        if "b' ∈∘ 𝔅⦇Obj⦈" and "a' = 0" for a' b'
      proof-
        from prems'(2) have ε_NTMap_app: 
          "ε⦇NTMap⦈⦇b'⦈ = (?the_ntcf_rKe ∙NTCF (σ' ∘NTCF-CF 𝔎))⦇NTMap⦈⦇b'⦈"
          for b'
          by simp
        show ?thesis
          using ε_NTMap_app[of b'] that(1)
          unfolding that(2)
          by
            (
              cs_prems
                cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_comma_cs_intros
            )
      qed
      {
        fix a' b' f' A
        note 𝔗.HomCod.cat_assoc_helper
          [
            where h=
              ‹?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈⦈∙›
              and g=‹σ'⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
              and q=‹ε⦇NTMap⦈⦇b'⦈›
          ]
      }
      note [cat_Kan_cs_simps] = this εb_𝔊f[symmetric]
      {
        fix a' b' f' A
        note 𝔗.HomCod.cat_assoc_helper
          [
            where h=‹
              ?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇
                a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈
                ⦈∙›
            and g=‹σ⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
            and q=‹ε⦇NTMap⦈⦇b'⦈›
          ]
      }
      note [cat_Kan_cs_simps] = this

      show "σ' = σ"
      proof(rule ntcf_eqI)

        show "σ' : 𝔊 ↦CF ?the_cf_rKe : ℭ ↦↦Cα 𝔄" by (rule prems'(1))
        show "σ : 𝔊 ↦CF ?the_cf_rKe : ℭ ↦↦Cα 𝔄" by (rule σ)

        have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = ℭ⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        have dom_rhs: "𝒟∘ (σ'⦇NTMap⦈) = ℭ⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)

        show "σ'⦇NTMap⦈ = σ⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

          fix c assume prems': "c ∈∘ ℭ⦇Obj⦈"

          note lim_c = assms(3)[OF prems']
          interpret lim_c: is_cat_limit 
            α ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹?UObj c› ‹?UArr c›
            by (rule lim_c)
          from prems' have CId_c: "ℭ⦇CId⦈⦇c⦈ : c ↦ℭ c"
            by (cs_concl cs_intro: cat_cs_intros)

          from lim_c.cat_lim_unique_cone'[OF τ[OF CId_c]] obtain f 
            where f: "f : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c"
              and "⋀A. A ∈∘ c ↓CF 𝔎⦇Obj⦈ ⟹
                τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘A𝔄 f"
              and f_unique: "⋀f'.
                ⟦
                  f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦𝔄 ?UObj c;
                  ⋀A. A ∈∘ c ↓CF 𝔎⦇Obj⦈ ⟹
                    τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘A𝔄 f'
                ⟧ ⟹ f' = f"
            by metis

          note [symmetric, cat_cs_simps] =
            σ.ntcf_Comp_commute
            σ'.ntcf_Comp_commute

          show "σ'⦇NTMap⦈⦇c⦈ = σ⦇NTMap⦈⦇c⦈"
          proof(rule trans_sym[where s=f])

            show "σ'⦇NTMap⦈⦇c⦈ = f"
            proof(rule f_unique)

              fix A assume prems'': "A ∈∘ c ↓CF 𝔎⦇Obj⦈"

              with prems' obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                by auto

              let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›

              from b' have 𝔎b': "?𝔎b' ∈∘ ℭ⦇Obj⦈"
                by (cs_concl cs_intro: cat_cs_intros)

              interpret lim_𝔎b': is_cat_limit
                α ‹?𝔎b' ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF ?𝔎b' O⨅CF 𝔎› ‹?UObj ?𝔎b'› ‹?UArr ?𝔎b'›
                by (rule assms(3)[OF 𝔎b'])

              from 𝔎b' have CId_𝔎b': "ℭ⦇CId⦈⦇?𝔎b'⦈ : ?𝔎b' ↦ℭ ?𝔎b'"
                by (cs_concl cs_intro: cat_cs_intros)
              from CId_𝔎b' b' have a'_b'_CId_𝔎b':
                "[0, b', ℭ⦇CId⦈⦇?𝔎b'⦈]∘ ∈∘ ?𝔎b' ↓CF 𝔎⦇Obj⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_comma_cs_simps
                      cs_intro: cat_cs_intros cat_comma_cs_intros
                  )
              from 
                lim_Obj_the_cf_rKe_commute[
                  where lim_Obj=lim_Obj, 
                  OF assms(1,2) lim_c assms(3)[OF 𝔎b'] f' a'_b'_CId_𝔎b'
                  ]
                f'
              have [cat_Kan_cs_simps]:
                "?UArr c⦇NTMap⦈⦇0, b', f'⦈∙ =
                  ?UArr ?𝔎b'⦇NTMap⦈⦇0, b', ℭ⦇CId⦈⦇?𝔎b'⦈⦈∙ ∘A𝔄 
                    ?the_cf_rKe⦇ArrMap⦈⦇f'⦈"
                by (cs_prems cs_simp: cat_cs_simps)

              from prems' prems'' b' f' show
                "τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘A𝔄 σ'⦇NTMap⦈⦇c⦈"
                unfolding A_def (*very slow*)
                by
                  (
                    cs_concl
                      cs_simp:
                        cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                      cs_intro:
                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                  )

            qed
              (
                use prems' in
                  ‹cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros›
              )

            show "σ⦇NTMap⦈⦇c⦈ = f"
            proof(rule f_unique)
              fix A assume prems'': "A ∈∘ c ↓CF 𝔎⦇Obj⦈"
              from this prems' obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
                by auto
              let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
              from b' have 𝔎b': "?𝔎b' ∈∘ ℭ⦇Obj⦈"
                by (cs_concl cs_intro: cat_cs_intros)
              interpret lim_𝔎b': is_cat_limit
                α ‹?𝔎b' ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF ?𝔎b' O⨅CF 𝔎› ‹?UObj ?𝔎b'› ‹?UArr ?𝔎b'›
                by (rule assms(3)[OF 𝔎b'])
              from 𝔎b' have CId_𝔎b': "ℭ⦇CId⦈⦇?𝔎b'⦈ : ?𝔎b' ↦ℭ ?𝔎b'"
                by (cs_concl cs_intro: cat_cs_intros)
              from CId_𝔎b' b' have a'_b'_CId_𝔎b': 
                "[0, b', ℭ⦇CId⦈⦇?𝔎b'⦈]∘ ∈∘ ?𝔎b' ↓CF 𝔎⦇Obj⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_comma_cs_simps
                      cs_intro: cat_cs_intros cat_comma_cs_intros
                  )

              from 
                lim_Obj_the_cf_rKe_commute
                  [
                    where lim_Obj=lim_Obj, 
                    OF assms(1,2) lim_c assms(3)[OF 𝔎b'] f' a'_b'_CId_𝔎b'
                  ]
                f'
              have [cat_Kan_cs_simps]:
                "?UArr c⦇NTMap⦈⦇0, b', f'⦈∙ =
                  ?UArr (?𝔎b')⦇NTMap⦈⦇0, b', ℭ⦇CId⦈⦇?𝔎b'⦈⦈∙ ∘A𝔄
                    ?the_cf_rKe⦇ArrMap⦈⦇f'⦈"
                by (cs_prems cs_simp: cat_cs_simps)
              from prems' prems'' b' f' show
                "τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘A𝔄 σ⦇NTMap⦈⦇c⦈"
                unfolding A_def (*very slow*)
                by
                  (
                    cs_concl
                      cs_simp:
                        cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                  )
            qed
              (
                use prems' in
                  ‹cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros›
              )
          qed

        qed auto

      qed simp_all

    qed

  qed (cs_concl cs_intro: cat_cs_intros)+

qed



subsection‹Preservation of Kan extension›


text‹
The following definitions are similar to the definitions that can be 
found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
›

locale is_cat_rKe_preserves =
  is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε + is_functor α 𝔄 𝔇 ℌ
  for α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔊 ℌ ε +
  assumes cat_rKe_preserves:
    "ℌ ∘CF-NTCF ε : (ℌ ∘CF 𝔊) ∘CF 𝔎 ↦CF.rKeα ℌ ∘CF 𝔗 : 𝔅 ↦C ℭ ↦C 𝔇"

syntax "_is_cat_rKe_preserves" :: 
  "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (
    ‹(_ :/ _ ∘CF _ ↦CF.rKeı _ :/ _ ↦C _ ↦C _ : _ ↦↦C _)› 
    [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
  )
translations "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C ℭ ↦C (ℌ : 𝔄 ↦↦C 𝔇)" ⇌ 
  "CONST is_cat_rKe_preserves α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔊 ℌ ε"

locale is_cat_lKe_preserves =
  is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η + is_functor α 𝔄 𝔇 ℌ
  for α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔉 ℌ η +
  assumes cat_lKe_preserves:
    "ℌ ∘CF-NTCF η : ℌ ∘CF 𝔗 ↦CF.lKeα (ℌ ∘CF 𝔉) ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C 𝔇"

syntax "_is_cat_lKe_preserves" :: 
  "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (
    ‹(_ :/ _ ↦CF.lKeı _ ∘CF _ :/ _ ↦C _ ↦C _ : _ ↦↦C _)› 
    [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
  )
translations "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C (ℌ : 𝔄 ↦↦C 𝔇)" ⇌
  "CONST is_cat_lKe_preserves α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔉 ℌ η"


text‹Rules.›

lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
  assumes "α' = α"
    and "𝔊' = 𝔊"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "ℌ' = ℌ"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
    and "𝔇' = 𝔇"
  shows "ε : 𝔊' ∘CF 𝔎' ↦CF.rKeα' 𝔗' : 𝔅' ↦C ℭ' ↦C (ℌ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_axioms)

mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
  |intro is_cat_rKe_preservesI|
  |dest is_cat_rKe_preservesD[dest]|
  |elim is_cat_rKe_preservesE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
  assumes "α' = α"
    and "𝔉' = 𝔉"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "ℌ' = ℌ"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
    and "𝔇' = 𝔇"
  shows "η : 𝔗' ↦CF.lKeα 𝔉' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C (ℌ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_lKe_preserves_axioms)

mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
  |intro is_cat_lKe_preservesI|
  |dest is_cat_lKe_preservesD[dest]|
  |elim is_cat_lKe_preservesE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)


text‹Duality.›

lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
  "op_ntcf ε :
    op_cf 𝔗 ↦CF.lKeα op_cf 𝔊 ∘CF op_cf 𝔎 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C (op_cf ℌ : op_cat 𝔄 ↦↦C op_cat 𝔇)"
proof(intro is_cat_lKe_preservesI)
  from cat_rKe_preserves show "op_cf ℌ ∘CF-NTCF op_ntcf ε :
    op_cf ℌ ∘CF op_cf 𝔗 ↦CF.lKeα (op_cf ℌ ∘CF op_cf 𝔊) ∘CF op_cf 𝔎 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔇"
    by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
      (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔊' = op_cf 𝔊"
    and "𝔎' = op_cf 𝔎"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
    and "𝔇' = op_cat 𝔇"
    and "ℌ' = op_cf ℌ"
  shows "op_ntcf ε :
    𝔗' ↦CF.lKeα 𝔊' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C (ℌ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_op)

lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'

lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
  "op_ntcf η :
    op_cf 𝔉 ∘CF op_cf 𝔎 ↦CF.rKeα op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C (op_cf ℌ : op_cat 𝔄 ↦↦C op_cat 𝔇)"
proof(intro is_cat_rKe_preservesI)
  from cat_lKe_preserves show "op_cf ℌ ∘CF-NTCF op_ntcf η :
    (op_cf ℌ ∘CF op_cf 𝔉) ∘CF op_cf 𝔎 ↦CF.rKeα op_cf ℌ ∘CF op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔇"
    by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
      (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "𝔎' = op_cf 𝔎"
    and "ℌ' = op_cf ℌ"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
    and "𝔇' = op_cat 𝔇"
  shows "op_ntcf η :
    𝔉' ∘CF 𝔎' ↦CF.rKeα 𝔗' : 𝔅' ↦C ℭ' ↦C (ℌ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_op)



subsection‹All concepts are Kan extensions›


text‹
Background information for this subsection is provided in 
Chapter X-7 in \cite{mac_lane_categories_2010}
and section 6.5 in \cite{riehl_category_2016}. 
It should be noted that only the connections between the Kan extensions,
limits and adjunctions are exposed (an alternative proof of the Yoneda
lemma using Kan extensions is not provided in the context of this work).
›


subsubsection‹Limits›

lemma cat_rKe_is_cat_limit:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.1 in \cite{riehl_category_2016}.›
  assumes "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C cat_1 𝔞 𝔣 ↦C 𝔄"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
  shows "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <CF.lim 𝔗 : 𝔅 ↦↦Cα 𝔄"
proof-

  interpret ε: is_cat_rKe α 𝔅 ‹cat_1 𝔞 𝔣› 𝔄 𝔎 𝔗 𝔊 ε by (rule assms(1))  
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  
  from cat_1_components(1) have 𝔞: "𝔞 ∈∘ Vset α" 
    by (auto simp: ε.AG.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset α" 
    by (auto simp: ε.AG.HomCod.cat_in_Arr_in_Vset)

  have 𝔎_def: "𝔎 = cf_const 𝔅 (cat_1 𝔞 𝔣) 𝔞"
    by (rule cf_const_if_HomCod_is_cat_1) 
      (cs_concl cs_intro: cat_cs_intros)
  have 𝔊𝔎_def: "𝔊 ∘CF 𝔎 = cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
    by
      (
        cs_concl
          cs_simp: cat_1_components(1) 𝔎_def cat_cs_simps 
          cs_intro: V_cs_intros cat_cs_intros
      )

  interpret ε: is_tm_ntcf α 𝔅 𝔄 ‹𝔊 ∘CF 𝔎› 𝔗 ε 
    by 
      (
        intro is_tm_ntcfI' assms(2) ε.ntcf_rKe.is_ntcf_axioms, 
        unfold 𝔊𝔎_def
      )
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
      )

  show "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <CF.lim 𝔗 : 𝔅 ↦↦Cα 𝔄"
  proof(intro is_cat_limitI' is_cat_coneI)

    show "ε : cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈) ↦CF.tm 𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    proof(intro is_tm_ntcfI' ε.ntcf_rKe.is_ntcf_axioms[unfolded 𝔊𝔎_def])
      from assms(2) show "cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈) : 𝔅 ↦↦C.tmα 𝔄"
        by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
    qed (rule assms(2))

    fix u' r' assume prems: "u' : r' <CF.cone 𝔗 : 𝔅 ↦↦Cα 𝔄"

    interpret u': is_cat_cone α r' 𝔅 𝔄 𝔗 u' by (rule prems)

    have 𝔊_def: "𝔊 = cf_const (cat_1 𝔞 𝔣) 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
      by (rule cf_const_if_HomDom_is_cat_1[OF ε.Ran.is_functor_axioms])

    from prems have const_r': "cf_const (cat_1 𝔞 𝔣) 𝔄 r' : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
        )

    have cf_comp_cf_const_r_𝔎_def: 
      "cf_const (cat_1 𝔞 𝔣) 𝔄 r' ∘CF 𝔎 = cf_const 𝔅 𝔄 r'"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps 𝔎_def
            cs_intro: cat_cs_intros cat_lim_cs_intros
        )

    from ε.cat_rKe_unique[
        OF const_r', unfolded cf_comp_cf_const_r_𝔎_def, OF u'.is_ntcf_axioms
        ] 
    obtain σ 
      where σ: "σ : cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
        and u'_def: "u' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)"
        and unique_σ: "⋀σ'.
          ⟦
            σ' : cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄;
            u' = ε ∙NTCF (σ' ∘NTCF-CF 𝔎)
          ⟧ ⟹ σ' = σ"
      by auto

    interpret σ: is_ntcf α ‹cat_1 𝔞 𝔣› 𝔄 ‹cf_const (cat_1 𝔞 𝔣) 𝔄 r'› 𝔊 σ
      by (rule σ)
    
    show "∃!f'. f' : r' ↦𝔄 𝔊⦇ObjMap⦈⦇𝔞⦈ ∧ u' = ε ∙NTCF ntcf_const 𝔅 𝔄 f'"
    proof(intro ex1I conjI; (elim conjE)?)
      fix f' assume prems': 
        "f' : r' ↦𝔄 𝔊⦇ObjMap⦈⦇𝔞⦈" "u' = ε ∙NTCF ntcf_const 𝔅 𝔄 f'"
      from prems'(1) have "ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' :
        cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
        by (subst 𝔊_def) 
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      moreover then have "u' = ε ∙NTCF (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' ∘NTCF-CF 𝔎)"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps prems'(2) 𝔎_def cs_intro: cat_cs_intros
          )
      ultimately have σ_def: "σ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'"
        by (auto simp: unique_σ[symmetric])
      show "f' = σ⦇NTMap⦈⦇𝔞⦈"
        by (cs_concl cs_simp: cat_cs_simps σ_def cs_intro: cat_cs_intros)
    qed (cs_concl cs_simp: cat_cs_simps u'_def 𝔎_def cs_intro: cat_cs_intros)+

  qed (cs_concl cs_simp: 𝔎_def cs_intro: cat_cs_intros)

qed

lemma cat_lKe_is_cat_colimit:
  assumes "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C cat_1 𝔞 𝔣 ↦C 𝔄"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
  shows "η : 𝔗 >CF.colim 𝔉⦇ObjMap⦈⦇𝔞⦈ : 𝔅 ↦↦Cα 𝔄"
proof-
  interpret η: is_cat_lKe α 𝔅 ‹cat_1 𝔞 𝔣› 𝔄 𝔎 𝔗 𝔉 η by (rule assms(1))  
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  from cat_1_components(1) have 𝔞: "𝔞 ∈∘ Vset α" 
    by (auto simp: η.AG.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset α" 
    by (auto simp: η.AG.HomCod.cat_in_Arr_in_Vset)
  show ?thesis
    by 
      (
        rule is_cat_limit.is_cat_colimit_op
          [
            OF cat_rKe_is_cat_limit[
              OF η.is_cat_rKe_op[unfolded η.AG.cat_1_op[OF 𝔞 𝔣]] 
              𝔗.is_tm_functor_op
              ], 
            unfolded cat_op_simps
          ]
      )
qed

lemma cat_limit_is_rKe:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010} 
    or Proposition 6.5.1 in \cite{riehl_category_2016}.›
  assumes "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <CF.lim 𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "𝔎 : 𝔅 ↦↦Cα cat_1 𝔞 𝔣"
    and "𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
  shows "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C cat_1 𝔞 𝔣 ↦C 𝔄"
proof-

  interpret ε: is_cat_limit α 𝔅 𝔄 𝔗 ‹𝔊⦇ObjMap⦈⦇𝔞⦈› ε by (rule assms)
  interpret 𝔎: is_functor α 𝔅 ‹cat_1 𝔞 𝔣› 𝔎 by (rule assms(2))
  interpret 𝔊: is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔊 by (rule assms(3))

  show ?thesis
  proof(rule is_cat_rKeI')

    note 𝔎_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
    note 𝔊_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]

    have 𝔊𝔎_def: "𝔊 ∘CF 𝔎 = cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
      by (subst 𝔎_def, use nothing in ‹subst 𝔊_def›)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

    show "ε : 𝔊 ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄" 
      by (cs_concl cs_simp: cat_cs_simps 𝔊𝔎_def cs_intro: cat_cs_intros)
    fix 𝔊' ε' assume prems: 
      "𝔊' : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
      "ε' : 𝔊' ∘CF 𝔎 ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"

    interpret is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔊' by (rule prems(1))
  
    note 𝔊'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]

    from prems(2) have ε': 
      "ε' : cf_const 𝔅 𝔄 (𝔊'⦇ObjMap⦈⦇𝔞⦈) ↦CF 𝔗 : 𝔅 ↦↦Cα 𝔄"
      unfolding 𝔎_def 
      by (subst (asm) 𝔊'_def)
        (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from prems(2) have "ε' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ <CF.cone 𝔗 : 𝔅 ↦↦Cα 𝔄"
      by (intro is_cat_coneI is_tm_ntcfI' ε')
        (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+

    from ε.cat_lim_unique_cone[OF this] obtain f'
      where f': "f' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦𝔄 𝔊⦇ObjMap⦈⦇𝔞⦈"
        and ε_def: "ε' = ε ∙NTCF ntcf_const 𝔅 𝔄 f'"
        and unique_f':
          "⟦
            f'' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦𝔄 𝔊⦇ObjMap⦈⦇𝔞⦈;
            ε' = ε ∙NTCF ntcf_const 𝔅 𝔄 f''
          ⟧ ⟹ f'' = f'"
        for f''
      by metis

    show "∃!σ.
      σ : 𝔊' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄 ∧ ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)"
    proof(intro ex1I conjI; (elim conjE)?)  
      from f' show 
        "ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' : 𝔊' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
        by (subst 𝔊'_def, use nothing in ‹subst 𝔊_def›) 
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      then show "ε' = ε ∙NTCF (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' ∘NTCF-CF 𝔎)"
        by (cs_concl cs_simp: cat_cs_simps ε_def 𝔎_def cs_intro: cat_cs_intros)
      fix σ assume prems:
        "σ : 𝔊' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
        "ε' = ε ∙NTCF (σ ∘NTCF-CF 𝔎)"
      interpret σ: is_ntcf α ‹cat_1 𝔞 𝔣› 𝔄 𝔊' 𝔊 σ by (rule prems(1))
      have "σ⦇NTMap⦈⦇𝔞⦈ : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦𝔄 𝔊⦇ObjMap⦈⦇𝔞⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      moreover have "ε' = ε ∙NTCF ntcf_const 𝔅 𝔄 (σ⦇NTMap⦈⦇𝔞⦈)"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps prems(2) 𝔎_def cs_intro: cat_cs_intros
          )
      ultimately have σ𝔞: "σ⦇NTMap⦈⦇𝔞⦈ = f'" by (rule unique_f')
      show "σ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'"
      proof(rule ntcf_eqI)
        from f' show 
          "ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' : 𝔊' ↦CF 𝔊 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
          by (subst 𝔊'_def, use nothing in ‹subst 𝔊_def›)
            (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = cat_1 𝔞 𝔣⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
        have dom_rhs: "𝒟∘ (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈) = cat_1 𝔞 𝔣⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
        show "σ⦇NTMap⦈ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ cat_1 𝔞 𝔣⦇Obj⦈"
          then have a_def: "a = 𝔞" unfolding cat_1_components by simp
          from f' show "σ⦇NTMap⦈⦇a⦈ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈⦇a⦈"
            unfolding a_def σ𝔞
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        qed (auto intro: cat_cs_intros)
      qed (simp_all add: prems)
    qed
  qed (auto simp: assms)

qed

lemma cat_colimit_is_lKe:
  assumes "η : 𝔗 >CF.colim 𝔉⦇ObjMap⦈⦇𝔞⦈ : 𝔅 ↦↦Cα 𝔄"
    and "𝔎 : 𝔅 ↦↦Cα cat_1 𝔞 𝔣"
    and "𝔉 : cat_1 𝔞 𝔣 ↦↦Cα 𝔄"
  shows "η : 𝔗 ↦CF.lKeα 𝔉 ∘CF 𝔎 : 𝔅 ↦C cat_1 𝔞 𝔣 ↦C 𝔄"
proof-
  interpret η: is_cat_colimit α 𝔅 𝔄 𝔗 ‹𝔉⦇ObjMap⦈⦇𝔞⦈› η
    by (rule assms(1))
  interpret 𝔎: is_functor α 𝔅 ‹cat_1 𝔞 𝔣› 𝔎 by (rule assms(2))
  interpret 𝔉: is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔉 by (rule assms(3))
  from cat_1_components(1) have 𝔞: "𝔞 ∈∘ Vset α"
    by (auto simp: 𝔎.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset α" 
    by (auto simp: 𝔎.HomCod.cat_in_Arr_in_Vset)
  have 𝔉𝔞: "𝔉⦇ObjMap⦈⦇𝔞⦈ = op_cf 𝔉⦇ObjMap⦈⦇𝔞⦈" unfolding cat_op_simps by simp
  note cat_1_op = η.cat_1_op[OF 𝔞 𝔣]
  show ?thesis
    by 
      (
        rule is_cat_rKe.is_cat_lKe_op
          [
            OF cat_limit_is_rKe
              [
                OF 
                  η.is_cat_limit_op[unfolded 𝔉𝔞]
                  𝔎.is_functor_op[unfolded cat_1_op]
                  𝔉.is_functor_op[unfolded cat_1_op]
              ],
            unfolded cat_op_simps cat_1_op
          ]
      )
qed


subsubsection‹Adjoints›

lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.2 in \cite{riehl_category_2016}.
    The proof follows (approximately) the proof in \cite{riehl_category_2016}.›
  shows "εC Φ : 𝔉 ∘CF 𝔊 ↦CF.rKeα cf_id 𝔇 : 𝔇 ↦C ℭ ↦C 𝔇"
proof-

  define β where "β = α + ω"
  have β: "𝒵 β" and αβ: "α ∈∘ β" 
    by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
  then interpret β: 𝒵 β by simp

  note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF β αβ R.category_axioms]

  let ?η = ‹ηC Φ›
  let ?ε = ‹εC Φ›
  let ?𝔇η = ‹exp_cat_ntcf α 𝔇 ?η›
  let ?𝔇𝔉 = ‹exp_cat_cf α 𝔇 𝔉›
  let ?𝔇𝔊 = ‹exp_cat_cf α 𝔇 𝔊›
  let ?𝔇𝔇 = ‹cat_FUNCT α 𝔇 𝔇›
  let ?ℭ𝔇 = ‹cat_FUNCT α ℭ 𝔇›
  let ?adj_𝔇η = ‹cf_adjunction_of_unit β ?𝔇𝔊 ?𝔇𝔉 ?𝔇η›

  interpret 𝔇η: is_cf_adjunction β ?ℭ𝔇 ?𝔇𝔇 ?𝔇𝔊 ?𝔇𝔉 ?adj_𝔇η by (rule exp_adj)

  show ?thesis
  proof(intro is_cat_rKeI)
    have id_𝔇: "cf_map (cf_id 𝔇) ∈∘ cat_FUNCT α 𝔇 𝔇⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_FUNCT_components(1)
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    then have exp_id_𝔇: 
      "exp_cat_cf α 𝔇 𝔉⦇ObjMap⦈⦇cf_map (cf_id 𝔇)⦈ = cf_map 𝔉"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
        )
    have 𝔉: "cf_map 𝔉 ∈∘ cat_FUNCT α ℭ 𝔇⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_components(1)
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    have ε: "ntcf_arrow (εC Φ) ∈∘ ntcf_arrows α 𝔇 𝔇"
      by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
    have 𝔇𝔇: "category β (cat_FUNCT α 𝔇 𝔇)"
      by (cs_concl cs_intro: cat_cs_intros)
    have ℭ𝔇: "category β (cat_FUNCT α ℭ 𝔇)"
      by (cs_concl cs_intro: cat_cs_intros)

    from 
      ε 𝔉 αβ id_𝔇 
      𝔇𝔇 ℭ𝔇 LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
      NT.is_iso_ntcf_axioms 
    have ε_id_𝔇: "εC ?adj_𝔇η⦇NTMap⦈⦇cf_map (cf_id 𝔇)⦈ = ntcf_arrow ?ε"
      by
        (
          cs_concl
            cs_simp:
              cat_Set_the_inverse[symmetric]
              cat_op_simps
              cat_cs_simps
              cat_FUNCT_cs_simps
              adj_cs_simps 
            cs_intro:
              𝔇η.NT.iso_ntcf_is_arr_isomorphism''
              cat_op_intros
              adj_cs_intros
              cat_small_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros
              cat_prod_cs_intros
        )      
   show "universal_arrow_fo ?𝔇𝔊 (cf_map (cf_id 𝔇)) (cf_map 𝔉) (ntcf_arrow ?ε)"
      by 
        (
          rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
            OF exp_adj id_𝔇, unfolded exp_id_𝔇 ε_id_𝔇
            ]
        )
  qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+

qed

lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
  shows "ηC Φ : cf_id ℭ ↦CF.lKeα 𝔊 ∘CF 𝔉 : ℭ ↦C 𝔇 ↦C ℭ"
  by 
    (
      rule is_cat_rKe.is_cat_lKe_op
        [
          OF is_cf_adjunction.cf_adjunction_counit_is_rKe
            [
              OF is_cf_adjunction_op,
              folded op_ntcf_cf_adjunction_unit op_cf_cf_id
            ],
          unfolded 
            cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
        ]
    )

lemma cf_adjunction_if_lKe_preserves:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.2 in \cite{riehl_category_2016}.›
  assumes "η : cf_id 𝔇 ↦CF.lKeα 𝔉 ∘CF 𝔊 : 𝔇 ↦C ℭ ↦C (𝔊 : 𝔇 ↦↦C ℭ)"
  shows "cf_adjunction_of_unit α 𝔊 𝔉 η : 𝔊 ⇌CF 𝔉 : 𝔇 ⇌⇌Cα ℭ"
proof-

  interpret η: is_cat_lKe_preserves α 𝔇 ℭ 𝔇 ℭ 𝔊 ‹cf_id 𝔇› 𝔉 𝔊 η 
    by (rule assms)

  from η.cat_lKe_preserves interpret 𝔊η:
    is_cat_lKe α 𝔇 ℭ ℭ 𝔊 𝔊 ‹𝔊 ∘CF 𝔉› ‹𝔊 ∘CF-NTCF η›
    by (cs_prems cs_simp: cat_cs_simps)

  from 
    𝔊η.cat_lKe_unique
      [
        OF η.AG.HomCod.cat_cf_id_is_functor,
        unfolded η.AG.cf_cf_comp_cf_id_left,
        OF η.AG.cf_ntcf_id_is_ntcf
      ]
  obtain ε where ε: "ε : 𝔊 ∘CF 𝔉 ↦CF cf_id ℭ : ℭ ↦↦Cα ℭ"
    and ntcf_id_𝔊_def: "ntcf_id 𝔊 = ε ∘NTCF-CF 𝔊 ∙NTCF (𝔊 ∘CF-NTCF η)"
    by metis
  interpret ε: is_ntcf α ℭ ℭ ‹𝔊 ∘CF 𝔉› ‹cf_id ℭ› ε by (rule ε)
  
  show ?thesis
  proof(rule counit_unit_is_cf_adjunction)

    show [cat_cs_simps]: "ε ∘NTCF-CF 𝔊 ∙NTCF (𝔊 ∘CF-NTCF η) = ntcf_id 𝔊"
      by (rule ntcf_id_𝔊_def[symmetric])

    have η_def: "η = (ntcf_id 𝔉 ∘NTCF-CF 𝔊) ∙NTCF η"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric] 
            cs_intro: cat_cs_intros
        )
    note [cat_cs_simps] = this[symmetric]

    let ?𝔉ε𝔊 = ‹𝔉 ∘CF-NTCF ε ∘NTCF-CF 𝔊›
    let ?η𝔉𝔊 = ‹η ∘NTCF-CF 𝔉 ∘NTCF-CF 𝔊›
    let ?𝔉𝔊η = ‹𝔉 ∘CF 𝔊 ∘CF-NTCF η›

    have "(?𝔉ε𝔊 ∙NTCF ?η𝔉𝔊) ∙NTCF η = (?𝔉ε𝔊 ∙NTCF ?𝔉𝔊η) ∙NTCF η"
    proof(rule ntcf_eqI)
      have dom_lhs: "𝒟∘ (((?𝔉ε𝔊 ∙NTCF ?η𝔉𝔊) ∙NTCF η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have dom_rhs: "𝒟∘ (((?𝔉ε𝔊 ∙NTCF ?𝔉𝔊η) ∙NTCF η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
      note category.cat_Comp_assoc[cat_cs_simps del]
      show
        "((?𝔉ε𝔊 ∙NTCF ?η𝔉𝔊) ∙NTCF η)⦇NTMap⦈ =
          ((?𝔉ε𝔊 ∙NTCF ?𝔉𝔊η) ∙NTCF η)⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume "a ∈∘ 𝔇⦇Obj⦈"
        then show
          "((?𝔉ε𝔊 ∙NTCF ?η𝔉𝔊) ∙NTCF η)⦇NTMap⦈⦇a⦈ =
            ((?𝔉ε𝔊 ∙NTCF ?𝔉𝔊η) ∙NTCF η)⦇NTMap⦈⦇a⦈"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps η.ntcf_lKe.ntcf_Comp_commute[symmetric]
                cs_intro: cat_cs_intros
            )
      qed (cs_concl cs_intro: cat_cs_intros)+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
    also have "… = (ntcf_id 𝔉 ∘NTCF-CF 𝔊) ∙NTCF η"
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cf_comp_cf_ntcf_comp_assoc
              cf_ntcf_comp_ntcf_cf_comp_assoc
              cf_ntcf_comp_ntcf_vcomp[symmetric]
            cs_intro: cat_cs_intros
        )
    also have "… = η" by (cs_concl cs_simp: cat_cs_simps)
    finally have "(?𝔉ε𝔊 ∙NTCF ?η𝔉𝔊) ∙NTCF η = η" by simp
    then have η_def':
      "η = (𝔉 ∘CF-NTCF ε ∙NTCF (η ∘NTCF-CF 𝔉) ∘NTCF-CF 𝔊) ∙NTCF η"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric] 
            cs_intro: cat_cs_intros
        )+
  
    have 𝔉εη𝔉:
      "𝔉 ∘CF-NTCF ε ∙NTCF (η ∘NTCF-CF 𝔉) : 𝔉 ↦CF 𝔉 : ℭ ↦↦Cα 𝔇"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

    from η.cat_lKe_unique[OF η.Lan.is_functor_axioms η.ntcf_lKe.is_ntcf_axioms]
    obtain σ where
      "⟦ σ' : 𝔉 ↦CF 𝔉 : ℭ ↦↦Cα 𝔇; η = σ' ∘NTCF-CF 𝔊 ∙NTCF η ⟧ ⟹ 
        σ' = σ"
      for σ'
      by metis
  
    from this[OF η.Lan.cf_ntcf_id_is_ntcf η_def] this[OF 𝔉εη𝔉 η_def'] show
      "𝔉 ∘CF-NTCF ε ∙NTCF (η ∘NTCF-CF 𝔉) = ntcf_id 𝔉"
      by simp

  qed (cs_concl cs_intro: cat_cs_intros)+

qed

lemma cf_adjunction_if_rKe_preserves:
  assumes "ε : 𝔉 ∘CF 𝔊 ↦CF.rKeα cf_id 𝔇 : 𝔇 ↦C ℭ ↦C (𝔊 : 𝔇 ↦↦C ℭ)"
  shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌CF 𝔊 : ℭ ⇌⇌Cα 𝔇"
proof-
  interpret ε: is_cat_rKe_preserves α 𝔇 ℭ 𝔇 ℭ 𝔊 ‹cf_id 𝔇› 𝔉 𝔊 ε 
    by (rule assms)
  have "op_cf (cf_id 𝔇) = cf_id (op_cat 𝔇)" unfolding cat_op_simps by simp
  show ?thesis
    by 
      (
        rule is_cf_adjunction.is_cf_adjunction_op
          [
            OF cf_adjunction_if_lKe_preserves[
              OF ε.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
              ], 
            folded cf_adjunction_of_counit_def, 
            unfolded cat_op_simps
          ]
      )
qed

text‹\newpage›

end

Theory CZH_UCAT_PWKan

(* Copyright 2021 (C) Mihails Milehins *)

section‹Pointwise Kan extensions›
theory CZH_UCAT_PWKan
  imports CZH_UCAT_Kan
begin



subsection‹Pointwise Kan extensions›


text‹
The following subsection is based on elements of the
content of section 6.3 in \cite{riehl_category_2016} and
Chapter X-5 in \cite{mac_lane_categories_2010}.
›

locale is_cat_pw_rKe = is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε
  for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε +
  assumes cat_pw_rKe_preserved: "a ∈∘ 𝔄⦇Obj⦈ ⟹
    ε :
      𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 :
      𝔅 ↦C ℭ ↦C (HomO.Cα𝔄(a,-) : 𝔄 ↦↦C cat_Set α)"

syntax "_is_cat_pw_rKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (
    ‹(_ :/ _ ∘CF _ ↦CF.rKe.pwı _ :/ _ ↦C _ ↦C _)› 
    [51, 51, 51, 51, 51, 51, 51] 51
  )
translations "ε : 𝔊 ∘CF 𝔎 ↦CF.rKe.pwα 𝔗 : 𝔅 ↦C ℭ ↦C 𝔄" ⇌ 
  "CONST is_cat_pw_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε"

locale is_cat_pw_lKe = is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η
  for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η +
  assumes cat_pw_lKe_preserved: "a ∈∘ op_cat 𝔄⦇Obj⦈ ⟹
    op_ntcf η :
      op_cf 𝔉 ∘CF op_cf 𝔎 ↦CF.rKeα op_cf 𝔗 :
      op_cat 𝔅 ↦C op_cat ℭ ↦C (HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦C cat_Set α)"

syntax "_is_cat_pw_lKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
  (
    ‹(_ :/ _ ↦CF.lKe.pwı _ ∘CF _ :/ _ ↦C _ ↦C _)› 
    [51, 51, 51, 51, 51, 51, 51] 51
  )
translations "η : 𝔗 ↦CF.lKe.pwα 𝔉 ∘CF 𝔎 : 𝔅 ↦C ℭ ↦C 𝔄" ⇌ 
  "CONST is_cat_pw_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η"

lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]: 
  assumes "a ∈∘ 𝔄⦇Obj⦈"
    and "𝔄' = 𝔄"
    and "ℌ' = HomO.Cα𝔄(a,-)"
    and "𝔈' = cat_Set α"
  shows "ε : 𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 : 𝔅 ↦C ℭ ↦C (ℌ' : 𝔄' ↦↦C 𝔈')"
  using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)

lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'

lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]: 
  assumes "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "𝔉' = op_cf 𝔉"
    and "𝔎' = op_cf 𝔎"
    and "𝔗' = op_cf 𝔗"
    and "𝔅' = op_cat 𝔅"
    and "ℭ' = op_cat ℭ"
    and "𝔄' = op_cat 𝔄"
    and "ℌ' = HomO.Cα𝔄(-,a)"
    and "𝔈' = cat_Set α"
  shows "op_ntcf η :
    𝔉' ∘CF 𝔎' ↦CF.rKeα 𝔗' : 𝔅' ↦C ℭ' ↦C (ℌ' : 𝔄' ↦↦C 𝔈')"
  using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)

lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'


text‹Rules.›

lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
  assumes "α' = α"
    and "𝔊' = 𝔊"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
  shows "ε : 𝔊' ∘CF 𝔎' ↦CF.rKe.pwα' 𝔗' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_rKe_axioms)

mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
  |intro is_cat_pw_rKeI|
  |dest is_cat_pw_rKeD[dest]|
  |elim is_cat_pw_rKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)

lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
  assumes "α' = α"
    and "𝔉' = 𝔉"
    and "𝔎' = 𝔎"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "ℭ' = ℭ"
  shows "η : 𝔗' ↦CF.lKe.pwα' 𝔉' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_lKe_axioms)

mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
  |intro is_cat_pw_lKeI|
  |dest is_cat_pw_lKeD[dest]|
  |elim is_cat_pw_lKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)


text‹Duality.›

lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
  "op_ntcf ε :
    op_cf 𝔗 ↦CF.lKe.pwα op_cf 𝔊 ∘CF op_cf 𝔎 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔄"
proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
  fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
  from cat_pw_rKe_preserved[OF prems] prems show
    "ε :
      𝔊 ∘CF 𝔎 ↦CF.rKeα 𝔗 :
      𝔅 ↦C ℭ ↦C (HomO.Cαop_cat 𝔄(-,a) : 𝔄 ↦↦C cat_Set α)"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
qed (cs_concl cs_intro: cat_op_intros)

lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔊' = op_cf 𝔊"
    and "𝔎' = op_cf 𝔎"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
  shows "op_ntcf ε : 𝔗' ↦CF.lKe.pwα 𝔊' ∘CF 𝔎' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_lKe_op)

lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'

lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
  "op_ntcf η :
    op_cf 𝔉 ∘CF op_cf 𝔎 ↦CF.rKe.pwα op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat ℭ ↦C op_cat 𝔄"
proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
  fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
  from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show 
    "op_ntcf η :
      op_cf 𝔉 ∘CF op_cf 𝔎 ↦CF.rKeα op_cf 𝔗 :
      op_cat 𝔅 ↦C op_cat ℭ ↦C
      (HomO.Cαop_cat 𝔄(a,-) : op_cat 𝔄 ↦↦C cat_Set α)"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
qed (cs_concl cs_intro: cat_op_intros)

lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "𝔎' = op_cf 𝔎"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "ℭ' = op_cat ℭ"
  shows "op_ntcf η : 𝔉' ∘CF 𝔎' ↦CF.rKe.pwα 𝔗' : 𝔅' ↦C ℭ' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_rKe_op)

lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'



(*FIXME: any reason not to generalize and include in CZH_UCAT_Hom?*)
subsection‹Cone functor›


subsubsection‹Definition and elementary properties›

definition cf_Cone :: "V ⇒ V ⇒ V ⇒ V"
  where "cf_Cone α β 𝔉 = 
    HomO.Cβcat_Funct α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈)(-,cf_map 𝔉) ∘CF
    op_cf (ΔC α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈))"


text‹An alternative form of the definition.›

context is_functor
begin

lemma cf_Cone_def': 
  "cf_Cone α β 𝔉 = HomO.Cβcat_Funct α 𝔄 𝔅(-,cf_map 𝔉) ∘CF op_cf (ΔC α 𝔄 𝔅)"
  unfolding cf_Cone_def cat_cs_simps by simp

end


subsubsection‹Object map›

lemma (in is_tm_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
  assumes "𝒵 β" and "α ∈∘ β" 
  shows "vsv (cf_Cone α β 𝔉⦇ObjMap⦈)"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ObjMap_vsv

lemma (in is_tm_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
  assumes "𝒵 β" and "α ∈∘ β" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝒟∘ (cf_Cone α β 𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def'
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_vdomain

lemma (in is_tm_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "cf_Cone α β 𝔉⦇ObjMap⦈⦇b⦈ =
    Hom (cat_Funct α 𝔄 𝔅) (cf_map (cf_const 𝔄 𝔅 b)) (cf_map 𝔉)"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2,3) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_app


subsubsection‹Arrow map›

lemma (in is_tm_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
  assumes "𝒵 β" and "α ∈∘ β" 
  shows "vsv (cf_Cone α β 𝔉⦇ArrMap⦈)"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ArrMap_vsv

lemma (in is_tm_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
  assumes "𝒵 β" and "α ∈∘ β" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝒟∘ (cf_Cone α β 𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def'
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_vdomain

lemma (in is_tm_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β" 
    and "f : a ↦𝔅 b"
  shows "cf_Cone α β 𝔉⦇ArrMap⦈⦇f⦈ = cf_hom
    (cat_Funct α 𝔄 𝔅)
    [ntcf_arrow (ntcf_const 𝔄 𝔅 f), cat_Funct α 𝔄 𝔅⦇CId⦈⦇cf_map 𝔉⦈]∘"
proof-
  from assms interpret β: 𝒵 β by simp 
  from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹ΔC α 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2,3) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_app


subsubsection‹The cone functor is a functor›

lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor:
  "cf_Cone α α 𝔉 : op_cat 𝔅 ↦↦Cα cat_Set α"
  unfolding cf_Cone_def'
  by
    (
      cs_concl
        cs_simp: cat_op_simps cat_Funct_components(1)
        cs_intro:
          cat_small_cs_intros
          cat_cs_intros
          cat_FUNCT_cs_intros
          cat_op_intros
    )

lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "cf_Cone α β 𝔉 : op_cat 𝔅 ↦↦Cβ cat_Set β"
proof-
  from assms interpret 𝔄𝔅: category α ‹cat_Funct α 𝔄 𝔅›
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret β_𝔄𝔅: category β ‹cat_Funct α 𝔄 𝔅›
    by (rule 𝔄𝔅.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros assms)+
  from assms interpret op_Δ: 
    is_tiny_functor β ‹op_cat 𝔅› ‹op_cat (cat_Funct α 𝔄 𝔅)› ‹op_cf (ΔC α 𝔄 𝔅)›
    by (intro is_functor.cf_is_tiny_functor_if_ge_Limit)
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  have "HomO.Cβcat_Funct α 𝔄 𝔅(-,cf_map 𝔉) :
    op_cat (cat_Funct α 𝔄 𝔅) ↦↦Cβ cat_Set β"
    by
      (
        cs_concl
          cs_simp: cat_Funct_components(1)
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  then show "cf_Cone α β 𝔉 : op_cat 𝔅 ↦↦Cβ cat_Set β"
    unfolding cf_Cone_def'
    by (cs_concl cs_intro: cat_cs_intros)
qed



subsection‹Lemma X.5: ‹L_10_5_N›\label{sec:lem_X_5_start}›


text‹
This subsection and several further subsections 
(\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
expose definitions that are used in the proof of the technical lemma that
was used in the proof of Theorem 3 from Chapter X-5
in \cite{mac_lane_categories_2010}.
›

definition L_10_5_N :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "L_10_5_N α β 𝔗 𝔎 c =
    [
      (
        λa∈∘𝔗⦇HomCod⦈⦇Obj⦈.
          cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗), c⦈∙
      ),
      (
        λf∈∘𝔗⦇HomCod⦈⦇Arr⦈.
          cf_nt α β 𝔎⦇ArrMap⦈⦇
            ntcf_arrow (HomA.Cα𝔗⦇HomCod⦈(f,-) ∘NTCF-CF 𝔗), 𝔎⦇HomCod⦈⦇CId⦈⦇c⦈
            ⦈∙
      ),
      op_cat (𝔗⦇HomCod⦈),
      cat_Set β
    ]∘"


text‹Components.›

lemma L_10_5_N_components:
  shows "L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈ =
      (
        λa∈∘𝔗⦇HomCod⦈⦇Obj⦈.
          cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗), c⦈∙
      )"
    and "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈ =
      (
        λf∈∘𝔗⦇HomCod⦈⦇Arr⦈.
          cf_nt α β 𝔎⦇ArrMap⦈⦇
            ntcf_arrow (HomA.Cα𝔗⦇HomCod⦈(f,-) ∘NTCF-CF 𝔗), 𝔎⦇HomCod⦈⦇CId⦈⦇c⦈
            ⦈∙
      )"
    and "L_10_5_N α β 𝔗 𝔎 c⦇HomDom⦈ = op_cat (𝔗⦇HomCod⦈)"
    and "L_10_5_N α β 𝔗 𝔎 c⦇HomCod⦈ = cat_Set β"
  unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_N_components' = L_10_5_N_components[
    where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
    ]

lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)

end


subsubsection‹Object map›

mk_VLambda L_10_5_N_components(1)
  |vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗 c
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

mk_VLambda L_10_5_N_components'(1)[OF 𝔎 𝔗]
  |vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]|

end


subsubsection‹Arrow map›

mk_VLambda L_10_5_N_components(2)
  |vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗 c
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

mk_VLambda L_10_5_N_components'(2)[OF 𝔎 𝔗]
  |vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]|

end


subsubsection‹‹L_10_5_N› is a functor›

lemma L_10_5_N_is_functor: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦Cβ cat_Set β"
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›

  interpret β: 𝒵 β by (rule assms(1))

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))

  from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+
  interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+

  from assms(2) interpret cf_nt: 
    is_functor β ‹?FUNCT 𝔅 ×C ℭ› ‹cat_Set β› ‹cf_nt α β 𝔎›
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show ?thesis
  proof(intro is_functorI')

    show "vfsequence (L_10_5_N α β 𝔗 𝔎 c)" unfolding L_10_5_N_def by simp
    show "vcard (L_10_5_N α β 𝔗 𝔎 c) = 4ℕ" 
      unfolding L_10_5_N_def by (simp add: nat_omega_simps)
    show "vsv (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈)" 
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    from assms(3,4) show "vsv (L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈)"
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    from assms show "𝒟∘ (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )
    show "ℛ∘ (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈) ⊆∘ cat_Set β⦇Obj⦈"
      unfolding L_10_5_N_components'[OF 𝔎.is_functor_axioms 𝔗.is_functor_axioms]
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      from prems assms show
        "cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗), c⦈∙ ∈∘
          cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl
              cs_simp: cat_Set_components(1) cat_cs_simps  cat_FUNCT_cs_simps
              cs_intro: 
                cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
          )
    qed

    from assms show "𝒟∘ (L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )

    show "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈ :
      L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈ ↦cat_Set β L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
      using that assms
      unfolding cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app 
            cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
        )

    show 
      "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇g ∘Aop_cat 𝔄 f⦈ =
        L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇g⦈ ∘Acat_Set β L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈"
      if "g : b' ↦op_cat 𝔄 c'" and "f : a' ↦op_cat 𝔄 b'" for b' c' g a' f
    proof-
      from that assms(5) show ?thesis
        unfolding cat_op_simps
        by (*slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_Kan_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                cf_nt.cf_ArrMap_Comp[symmetric]
          )
    qed

    show 
      "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ =
        cat_Set β⦇CId⦈⦇L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof-
      note [cat_cs_simps] = 
        ntcf_id_cf_comp[symmetric] 
        ntcf_arrow_id_ntcf_id[symmetric]
        cat_FUNCT_CId_app[symmetric] 
      from that[unfolded cat_op_simps] assms show ?thesis
        by (*slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
              cs_simp: 
                cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
          )
    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed

lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = cat_Set β"
    and "β' = β"
  shows "L_10_5_N α β 𝔗 𝔎 c : 𝔄' ↦↦Cβ' 𝔅'"
  using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)



subsection‹Lemma X.5: ‹L_10_5_υ_arrow››


subsubsection‹Definition and elementary properties›

definition L_10_5_υ_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "L_10_5_υ_arrow 𝔗 𝔎 c τ a b =
    [
      (λf∈∘Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈). τ⦇NTMap⦈⦇0, b, f⦈∙),
      Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈),
      Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMap⦈⦇b⦈)
    ]∘"


text‹Components.›

lemma L_10_5_υ_arrow_components:
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrVal⦈ =
    (λf∈∘Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈). τ⦇NTMap⦈⦇0, b, f⦈∙)"
    and "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrDom⦈ = Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈)"
    and "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrCod⦈ = Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMap⦈⦇b⦈)"
  unfolding L_10_5_υ_arrow_def arr_field_simps 
  by (simp_all add: nat_omega_simps) 

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_υ_arrow_components' = L_10_5_υ_arrow_components[
    where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
    ]

lemmas [cat_Kan_cs_simps] = L_10_5_υ_arrow_components'(2,3)

end


subsubsection‹Arrow value›

mk_VLambda L_10_5_υ_arrow_components(1)
  |vsv L_10_5_υ_arrow_ArrVal_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

mk_VLambda L_10_5_υ_arrow_components'(1)[OF 𝔎 𝔗]
  |vdomain L_10_5_υ_arrow_ArrVal_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_υ_arrow_ArrVal_app[unfolded in_Hom_iff]|

end

lemma L_10_5_υ_arrow_ArrVal_app':
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrVal⦈⦇f⦈ = τ⦇NTMap⦈⦇0, b, f⦈∙"
proof-
  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  from assms(3) have c: "c ∈∘ ℭ⦇Obj⦈" by auto
  show ?thesis by (rule L_10_5_υ_arrow_ArrVal_app[OF assms(1,2,3)])
qed


subsubsection‹‹L_10_5_υ_arrow› is an arrow›

lemma L_10_5_υ_arrow_ArrVal_is_arr: 
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "τ' = ntcf_arrow τ"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈⦇f⦈ : a ↦𝔄 𝔗⦇ObjMap⦈⦇b⦈"
proof-
  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ by (rule assms(4))
  from assms(5,6) show ?thesis
    unfolding assms(3)
    by
      (
        cs_concl
          cs_simp:
            cat_cs_simps
            L_10_5_υ_arrow_ArrVal_app
            cat_comma_cs_simps
            cat_FUNCT_cs_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed

lemma L_10_5_υ_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]: 
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "τ' = ntcf_arrow τ"
    and "a' = a"
    and "b' = 𝔗⦇ObjMap⦈⦇b⦈"
    and "𝔄' = 𝔄"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈⦇f⦈ : a' ↦𝔄 b'"
  using assms(1-3, 7-9) 
  unfolding assms(3-6) 
  by (rule L_10_5_υ_arrow_ArrVal_is_arr)


subsubsection‹Further elementary properties›

lemma L_10_5_υ_arrow_is_arr: 
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "τ' = ntcf_arrow τ"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b :
    Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
proof-
  note L_10_5_υ_arrow_components = L_10_5_υ_arrow_components'[OF assms(1,2)]
  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ by (rule assms(5))
  show ?thesis
  proof(intro cat_Set_is_arrI)
    show "arr_Set α (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b)"
    proof(intro arr_SetI)
      show "vfsequence (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b)" 
        unfolding L_10_5_υ_arrow_def by simp
      show "vcard (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b) = 3ℕ"
        unfolding L_10_5_υ_arrow_def by (simp add: nat_omega_simps)
      show 
        "ℛ∘ (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈) ⊆∘
          L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrCod⦈"
        unfolding L_10_5_υ_arrow_components
      proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
        fix f assume "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
        from L_10_5_υ_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this 
        show "τ'⦇NTMap⦈⦇0, b, f⦈∙ : a ↦𝔄 𝔗⦇ObjMap⦈⦇b⦈"
          by 
            (
              cs_prems 
                cs_simp: L_10_5_υ_arrow_ArrVal_app' cat_cs_simps 
                cs_intro: cat_cs_intros
            ) 
      qed
      from assms(3,6) show "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrDom⦈ ∈∘ Vset α"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
      from assms(1-3,6) τ.cat_cone_obj show
        "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrCod⦈ ∈∘ Vset α"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    qed (auto simp: L_10_5_υ_arrow_components)
  qed (simp_all add: L_10_5_υ_arrow_components)
qed

lemma L_10_5_υ_arrow_is_arr'[cat_Kan_cs_intros]: 
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "τ' = ntcf_arrow τ"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "A = Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
    and "B = Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
    and "ℭ' = cat_Set α"
  shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b : A ↦ℭ' B"
  using assms(1-6) unfolding assms(7-9) by (rule L_10_5_υ_arrow_is_arr)

lemma L_10_5_υ_cf_hom[cat_Kan_cs_simps]:
  assumes "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "τ' = ntcf_arrow τ"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "f : a' ↦𝔅 b'"
  shows 
    "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b' ∘Acat_Set α
    cf_hom ℭ [ℭ⦇CId⦈⦇c⦈, 𝔎⦇ArrMap⦈⦇f⦈]∘ =
      cf_hom 𝔄 [𝔄⦇CId⦈⦇a⦈, 𝔗⦇ArrMap⦈⦇f⦈]∘ ∘Acat_Set α
      L_10_5_υ_arrow 𝔗 𝔎 c τ' a a'"
    (is "?lhs = ?rhs")
proof-

  interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ by (rule assms(5))

  have [cat_Kan_cs_simps]:
    "τ⦇NTMap⦈⦇a'', b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f'⦈∙ = 
      𝔗⦇ArrMap⦈⦇h'⦈ ∘A𝔄 τ⦇NTMap⦈⦇a', b', f'⦈∙"
    if F_def: "F = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
      and A_def: "A = [a', b', f']∘"
      and B_def: "B = [a'', b'', f'']∘"
      and F: "F : A ↦c ↓CF 𝔎 B"
    for F A B a' b' f' a'' b'' f'' g' h'
  proof-
    from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
      and a''_def: "a'' = 0"
      and g'_def: "g' = 0"
      and h': "h' : b' ↦𝔅 b''"
      and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
      and f'': "f'' : c ↦ℭ 𝔎⦇ObjMap⦈⦇b''⦈"
      and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f' = f''"
      by auto
    from 
      τ.ntcf_Comp_commute[OF F] 
      that(2) F g' h' f' f'' 
      𝔎.is_functor_axioms 
      𝔗.is_functor_axioms 
    show 
      "τ⦇NTMap⦈⦇a'', b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘Aℭ f'⦈∙ = 
        𝔗⦇ArrMap⦈⦇h'⦈ ∘A𝔄 τ⦇NTMap⦈⦇a', b', f'⦈∙"
      unfolding F_def A_def B_def a'_def a''_def g'_def 
      by (*slow*)
        (
          cs_prems 1
            cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed

  from assms(3) assms(6,7) 𝔎.HomCod.category_axioms have lhs_is_arr:
    "?lhs : Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b'⦈)"
    unfolding assms(4)
    by
      (
        cs_concl cs_simp: cs_intro:
          cat_lim_cs_intros 
          cat_cs_intros 
          cat_Kan_cs_intros 
          cat_prod_cs_intros 
          cat_op_intros
      )
  then have dom_lhs: "𝒟∘ ((?lhs)⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)
  from assms(3) assms(6,7) 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms 
  have rhs_is_arr:
    "?rhs : Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b'⦈)"
    unfolding assms(4)
    by
      (
        cs_concl cs_intro:
          cat_lim_cs_intros 
          cat_cs_intros 
          cat_Kan_cs_intros 
          cat_prod_cs_intros 
          cat_op_intros
      )
  then have dom_rhs: "𝒟∘ ((?rhs)⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)
  show ?thesis
  proof(rule arr_Set_eqI)
    from lhs_is_arr show arr_Set_lhs: "arr_Set α ?lhs"
      by (auto dest: cat_Set_is_arrD(1))
    from rhs_is_arr show arr_Set_rhs: "arr_Set α ?rhs"
      by (auto dest: cat_Set_is_arrD(1))
    show "?lhs⦇ArrVal⦈ = ?rhs⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix g assume prems: "g : c ↦ℭ 𝔎⦇ObjMap⦈⦇a'⦈"
      from prems assms(7) have 𝔎f: 
        "𝔎⦇ArrMap⦈⦇f⦈ ∘Aℭ g : c ↦ℭ 𝔎⦇ObjMap⦈⦇b'⦈"
        by (cs_concl cs_intro: cat_cs_intros)
      with assms(6,7) prems 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      show "?lhs⦇ArrVal⦈⦇g⦈ = ?rhs⦇ArrVal⦈⦇g⦈"
          by (*slow*)
            (
              cs_concl
                cs_intro:
                  cat_lim_cs_intros 
                  cat_cs_intros 
                  cat_Kan_cs_intros
                  cat_comma_cs_intros
                  cat_prod_cs_intros 
                  cat_op_intros 
                  cat_1_is_arrI
                cs_simp:
                  L_10_5_υ_arrow_ArrVal_app' 
                  cat_cs_simps
                  cat_Kan_cs_simps
                  cat_op_simps
                  cat_FUNCT_cs_simps
                  cat_comma_cs_simps
                  assms(4)
            )+
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed
    (
      use lhs_is_arr rhs_is_arr in
        ‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
    )+
qed



subsection‹Lemma X.5: ‹L_10_5_τ››


subsubsection‹Definition and elementary properties›

definition L_10_5_τ where "L_10_5_τ 𝔗 𝔎 c υ a = 
  [
    (λbf∈∘c ↓CF 𝔎⦇Obj⦈. υ⦇NTMap⦈⦇bf⦇1ℕ⦈⦈⦇ArrVal⦈⦇bf⦇2ℕ⦈⦈),
    cf_const (c ↓CF 𝔎) (𝔗⦇HomCod⦈) a,
    𝔗 ∘CF c O⨅CF 𝔎,
    c ↓CF 𝔎,
    (𝔗⦇HomCod⦈)
  ]∘"


text‹Components.›

lemma L_10_5_τ_components: 
  shows "L_10_5_τ 𝔗 𝔎 c υ a⦇NTMap⦈ =
    (λbf∈∘c ↓CF 𝔎⦇Obj⦈. υ⦇NTMap⦈⦇bf⦇1ℕ⦈⦈⦇ArrVal⦈⦇bf⦇2ℕ⦈⦈)"
    and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDom⦈ = cf_const (c ↓CF 𝔎) (𝔗⦇HomCod⦈) a"
    and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTCod⦈ = 𝔗 ∘CF c O⨅CF 𝔎"
    and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDGDom⦈ = c ↓CF 𝔎"
    and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDGCod⦈ = (𝔗⦇HomCod⦈)"
  unfolding L_10_5_τ_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_τ_components' = L_10_5_τ_components[
  where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
  ]

lemmas [cat_Kan_cs_simps] = L_10_5_τ_components'(2-5)

end


subsubsection‹Natural transformation map›

mk_VLambda L_10_5_τ_components(1)
  |vsv L_10_5_τ_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_τ_NTMap_vdomain[cat_Kan_cs_simps]|

lemma L_10_5_τ_NTMap_app[cat_Kan_cs_simps]: 
  assumes "bf = [0, b, f]∘" and "bf ∈∘ c ↓CF 𝔎⦇Obj⦈" 
  shows "L_10_5_τ 𝔗 𝔎 c υ a⦇NTMap⦈⦇bf⦈ = υ⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈"
  using assms unfolding L_10_5_τ_components by (simp add: nat_omega_simps)


subsubsection‹‹L_10_5_τ› is a cone›

lemma L_10_5_τ_is_cat_cone[cat_cs_intros]:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and υ'_def: "υ' = ntcf_arrow υ"
    and υ: "υ :
      HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_τ 𝔗 𝔎 c υ' a : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
proof-

  let ?H_ℭ = ‹λc. HomO.Cαℭ(c,-)› 
  let ?H_𝔄 = ‹λa. HomO.Cα𝔄(a,-)›

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  from assms(3) interpret c𝔎: tiny_category α ‹c ↓CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(3) interpret Πc: is_tm_functor α ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret υ: is_ntcf α 𝔅 ‹cat_Set α› ‹?H_ℭ c ∘CF 𝔎› ‹?H_𝔄 a ∘CF 𝔗› υ
    by (rule υ)

  show ?thesis
  proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
    show "vfsequence (L_10_5_τ 𝔗 𝔎 c υ' a)" unfolding L_10_5_τ_def by simp
    show "vcard (L_10_5_τ 𝔗 𝔎 c υ' a) = 5ℕ" 
      unfolding L_10_5_τ_def by (simp add: nat_omega_simps)
    from a interpret cf_const:
      is_tm_functor α ‹c ↓CF 𝔎› 𝔄 ‹cf_const (c ↓CF 𝔎) 𝔄 a› 
      by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
    show "L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇bf⦈ :
      cf_const (c ↓CF 𝔎) 𝔄 a⦇ObjMap⦈⦇bf⦈ ↦𝔄 (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇bf⦈"
      if "bf ∈∘ c ↓CF 𝔎⦇Obj⦈" for bf
    proof-
      from that assms(3) obtain b f 
        where bf_def: "bf = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
        by auto
      from υ.ntcf_NTMap_is_arr[OF b] a b assms(3) f have "υ⦇NTMap⦈⦇b⦈ :
        Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
        by
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
      with that b f show "L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇bf⦈ :
        cf_const (c ↓CF 𝔎) 𝔄 a⦇ObjMap⦈⦇bf⦈ ↦𝔄 (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇bf⦈"
        unfolding bf_def υ'_def
        by
          (
            cs_concl
              cs_simp:
                cat_cs_simps 
                cat_Kan_cs_simps 
                cat_comma_cs_simps
                cat_FUNCT_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed

    show 
      "L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇B⦈ ∘A𝔄 cf_const (c ↓CF 𝔎) 𝔄 a⦇ArrMap⦈⦇F⦈ =
        (𝔗 ∘CF c O⨅CF 𝔎)⦇ArrMap⦈⦇F⦈ ∘A𝔄 L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇A⦈"
      if "F : A ↦c ↓CF 𝔎 B" for A B F
    proof-
      from 𝔎.is_functor_axioms that assms(3) obtain a' f a'' f' g 
        where F_def: "F = [[0, a', f]∘, [0, a'', f']∘, [0, g]∘]∘"
          and A_def: "A = [0, a', f]∘"
          and B_def: "B = [0, a'', f']∘"
          and g: "g : a' ↦𝔅 a''"
          and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇a'⦈"
          and f': "f' : c ↦ℭ 𝔎⦇ObjMap⦈⦇a''⦈" 
          and f'_def: "𝔎⦇ArrMap⦈⦇g⦈ ∘Aℭ f = f'" 
        by auto
      from υ.ntcf_Comp_commute[OF g] have 
        "(υ⦇NTMap⦈⦇a''⦈ ∘Acat_Set α (?H_ℭ c ∘CF 𝔎)⦇ArrMap⦈⦇g⦈)⦇ArrVal⦈⦇f⦈ =
          ((?H_𝔄 a ∘CF 𝔗)⦇ArrMap⦈⦇g⦈ ∘Acat_Set α υ⦇NTMap⦈⦇a'⦈)⦇ArrVal⦈⦇f⦈"
        by simp
      from this a g f f' 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      have [cat_cs_simps]:
        "υ⦇NTMap⦈⦇a''⦈⦇ArrVal⦈⦇𝔎⦇ArrMap⦈⦇g⦈ ∘Aℭ f⦈ = 
          𝔗⦇ArrMap⦈⦇g⦈ ∘A𝔄 υ⦇NTMap⦈⦇a'⦈⦇ArrVal⦈⦇f⦈"
        by (*slow*)
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
          )
      from that a g f f' 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      show ?thesis
        unfolding F_def A_def B_def υ'_def (*slow*)
        by
          (
            cs_concl
              cs_simp:
                f'_def[symmetric] 
                cat_cs_simps 
                cat_Kan_cs_simps 
                cat_comma_cs_simps 
                cat_FUNCT_cs_simps
                cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
    qed

  qed
    (
      use assms in
        ‹
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros a
        ›
    )+

qed

lemma L_10_5_τ_is_cat_cone'[cat_Kan_cs_intros]:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "υ' = ntcf_arrow υ"
    and "𝔉' = 𝔗 ∘CF c O⨅CF 𝔎"
    and "c𝔎 = c ↓CF 𝔎"
    and "𝔄' = 𝔄"
    and "α' = α"
    and "υ :
      HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
      𝔅 ↦↦Cα cat_Set α"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_τ 𝔗 𝔎 c υ' a : a <CF.cone 𝔉' : c𝔎 ↦↦Cα' 𝔄'"
  using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_τ_is_cat_cone)



subsection‹Lemma X.5: ‹L_10_5_υ››


subsubsection‹Definition and elementary properties›

definition L_10_5_υ :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "L_10_5_υ α 𝔗 𝔎 c τ a =
    [
      (λb∈∘𝔗⦇HomDom⦈⦇Obj⦈. L_10_5_υ_arrow 𝔗 𝔎 c τ a b),
      HomO.Cα𝔎⦇HomCod⦈(c,-) ∘CF 𝔎,
      HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗,
      𝔗⦇HomDom⦈,
      cat_Set α
    ]∘"


text‹Components.›

lemma L_10_5_υ_components: 
  shows "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTMap⦈ =
    (λb∈∘𝔗⦇HomDom⦈⦇Obj⦈. L_10_5_υ_arrow 𝔗 𝔎 c τ a b)"
    and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDom⦈ = HomO.Cα𝔎⦇HomCod⦈(c,-) ∘CF 𝔎"
    and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTCod⦈ = HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗"
    and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
    and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDGCod⦈ = cat_Set α"
  unfolding L_10_5_υ_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_υ_components' = L_10_5_υ_components[
  where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
  ]

lemmas [cat_Kan_cs_simps] = L_10_5_υ_components'(2-5)

end


subsubsection‹Natural transformation map›

mk_VLambda L_10_5_υ_components(1)
  |vsv L_10_5_υ_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
  assumes 𝔎: "𝔎 : 𝔅 ↦↦Cα ℭ"
    and 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda L_10_5_υ_components'(1)[OF 𝔎 𝔗]
  |vdomain L_10_5_υ_NTMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_υ_NTMap_app[cat_Kan_cs_simps]|

end


subsubsection‹‹L_10_5_υ› is a natural transformation›

lemma L_10_5_υ_is_ntcf:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and τ'_def: "τ' = ntcf_arrow τ"
    and τ: "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_υ α 𝔗 𝔎 c τ' a :
    HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
    (is ‹?L_10_5_υ : ?H_ℭ c ∘CF 𝔎 ↦CF ?H_𝔄 a ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α›)
proof-

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ  
    by (rule assms(5))

  from assms(3) interpret c𝔎: tiny_category α ‹c ↓CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(3) interpret Πc: is_tm_functor α ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )

  show "?L_10_5_υ : ?H_ℭ c ∘CF 𝔎 ↦CF ?H_𝔄 a ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
  proof(intro is_ntcfI')
    show "vfsequence ?L_10_5_υ" unfolding L_10_5_υ_def by auto
    show "vcard ?L_10_5_υ = 5ℕ" 
      unfolding L_10_5_υ_def by (simp add: nat_omega_simps)
    show "?L_10_5_υ⦇NTMap⦈⦇b⦈ :
      (?H_ℭ c ∘CF 𝔎)⦇ObjMap⦈⦇b⦈ ↦cat_Set α (?H_𝔄 a ∘CF 𝔗)⦇ObjMap⦈⦇b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      from a that assms(3) show ?thesis
        unfolding τ'_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_lim_cs_intros
                cat_cs_intros
                cat_op_intros
          )
    qed
    show
      "?L_10_5_υ⦇NTMap⦈⦇b'⦈ ∘Acat_Set α (?H_ℭ c ∘CF 𝔎)⦇ArrMap⦈⦇f⦈ =
        (?H_𝔄 a ∘CF 𝔗)⦇ArrMap⦈⦇f⦈ ∘Acat_Set α ?L_10_5_υ⦇NTMap⦈⦇a'⦈"
      if "f : a' ↦𝔅 b'" for a' b' f
    proof-
      from that a assms(3) show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps τ'_def
              cs_intro: cat_lim_cs_intros cat_cs_intros 
          )
    qed

  qed
    (
      use assms(3,6) in
        ‹
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps
            cs_intro: cat_cs_intros cat_Kan_cs_intros
        ›
    )+

qed

lemma L_10_5_υ_is_ntcf'[cat_Kan_cs_intros]:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "τ' = ntcf_arrow τ"
    and "𝔉' = HomO.Cαℭ(c,-) ∘CF 𝔎"
    and "𝔊' = HomO.Cα𝔄(a,-) ∘CF 𝔗"
    and "𝔅' = 𝔅"
    and "ℭ' = cat_Set α"
    and "α' = α"
    and "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_υ α 𝔗 𝔎 c τ' a : 𝔉' ↦CF 𝔊' : 𝔅' ↦↦Cα' ℭ'"
  using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_υ_is_ntcf)



subsection‹Lemma X.5: ‹L_10_5_χ_arrow››


subsubsection‹Definition and elementary properties›

definition L_10_5_χ_arrow 
  where "L_10_5_χ_arrow α β 𝔗 𝔎 c a =
    [
      (λυ∈∘L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈. ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ a)), 
      L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈,
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈
    ]∘"


text‹Components.›

lemma L_10_5_χ_arrow_components: 
  shows "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈ = 
      (λυ∈∘L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈. ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ a))"
    and "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrDom⦈ = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
    and "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrCod⦈ = 
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
  unfolding L_10_5_χ_arrow_def arr_field_simps
  by (simp_all add: nat_omega_simps)

lemmas [cat_Kan_cs_simps] = L_10_5_χ_arrow_components(2,3)


subsubsection‹Arrow value›

mk_VLambda L_10_5_χ_arrow_components(1)
  |vsv L_10_5_χ_arrow_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_χ_arrow_vdomain|
  |app L_10_5_χ_arrow_app|

lemma L_10_5_χ_arrow_vdomain'[cat_Kan_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝒟∘ (L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈) = Hom 
    (cat_FUNCT α 𝔅 (cat_Set α)) 
    (cf_map (HomO.Cαℭ(c,-) ∘CF 𝔎)) 
    (cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗))"
  using assms
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_χ_arrow_vdomain 
        cs_intro: cat_cs_intros
    )

lemma L_10_5_χ_arrow_app'[cat_Kan_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦Cα ℭ"
    and "𝔗 : 𝔅 ↦↦Cα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and υ'_def: "υ' = ntcf_arrow υ"
    and υ: "υ :
      HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows 
    "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇υ'⦈ =
      ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ' a)"
  using assms
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_χ_arrow_app 
        cs_intro: cat_cs_intros cat_FUNCT_cs_intros
    )

lemma υτa_def:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and υτa'_def: "υτa' = ntcf_arrow υτa"
    and υτa: "υτa :
      HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
      𝔅 ↦↦Cα cat_Set α"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "υτa = L_10_5_υ α 𝔗 𝔎 c (ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa' a)) a"
  (is ‹υτa = ?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a›)
proof-

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  interpret υτa: is_ntcf 
    α 𝔅 ‹cat_Set α› ‹HomO.Cαℭ(c,-) ∘CF 𝔎› ‹HomO.Cα𝔄(a,-) ∘CF 𝔗› υτa
    by (rule υτa)

  show ?thesis
  proof(rule ntcf_eqI)
    show "υτa : 
      HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
      by (rule υτa)
    from assms(1-3) a show 
      "?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a :
        HomO.Cαℭ(c,-) ∘CF 𝔎 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α" 
      by
        (
          cs_concl
            cs_simp: cat_Kan_cs_simps υτa'_def
            cs_intro: cat_cs_intros cat_Kan_cs_intros
        )
    have dom_lhs: "𝒟∘ (υτa⦇NTMap⦈) = 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    have dom_rhs: "𝒟∘ (?L_10_5_υ (ntcf_arrow (?L_10_5_τ)) a⦇NTMap⦈) = 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    show "υτa⦇NTMap⦈ = ?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
      from prems assms(3) a have lhs: "υτa⦇NTMap⦈⦇b⦈ :
        Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
          )
      then have dom_lhs: "𝒟∘ (υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
        by (cs_concl cs_simp: cat_cs_simps)
      from prems assms(3) a have rhs: 
        "L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b :
          Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦cat_Set α Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
        unfolding υτa'_def
        by
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps 
              cs_intro: cat_small_cs_intros cat_Kan_cs_intros cat_cs_intros
          )

      then have dom_rhs: 
        "𝒟∘ (L_10_5_υ_arrow 𝔗 𝔎 c  (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈) =
          Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
        by (cs_concl cs_simp: cat_cs_simps)
      have [cat_cs_simps]:  
        "υτa⦇NTMap⦈⦇b⦈ = L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b"
      proof(rule arr_Set_eqI)
        from lhs show arr_Set_lhs: "arr_Set α (υτa⦇NTMap⦈⦇b⦈)"
          by (auto dest: cat_Set_is_arrD(1))
        from rhs show arr_Set_rhs: 
          "arr_Set α (L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow (?L_10_5_τ)) a b)"
          by (auto dest: cat_Set_is_arrD(1))
        show "υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈ = 
          L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix f assume "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
          with assms prems show 
            "υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈ =
              L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈⦇f⦈"
            unfolding υτa'_def
            by
              (
                cs_concl
                  cs_simp:
                    cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_υ_arrow_ArrVal_app 
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed (use arr_Set_lhs arr_Set_rhs in auto)
      qed (use lhs rhs in ‹cs_concl cs_simp: cat_cs_simps›)+

      from prems show 
        "υτa⦇NTMap⦈⦇b⦈ = L_10_5_υ α 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a⦇NTMap⦈⦇b⦈"
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )

    qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+

  qed simp_all

qed



subsection‹Lemma X.5: ‹L_10_5_χ'_arrow››


subsubsection‹Definition and elementary properties›

definition L_10_5_χ'_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "L_10_5_χ'_arrow α β 𝔗 𝔎 c a =
    [
      (
        λτ∈∘cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈.
          ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a)
      ),
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈,
      L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈
    ]∘"


text‹Components.›

lemma L_10_5_χ'_arrow_components:
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈ =
    (
      λτ∈∘cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈.
        ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a)
    )"
    and [cat_Kan_cs_simps]: "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrDom⦈ =
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
    and [cat_Kan_cs_simps]: "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrCod⦈ =
       L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
  unfolding L_10_5_χ'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Arrow value›

mk_VLambda L_10_5_χ'_arrow_components(1)
  |vsv L_10_5_χ'_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_χ'_arrow_ArrVal_vdomain|
  |app L_10_5_χ'_arrow_ArrVal_app|

lemma L_10_5_χ'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and τ: "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝒟∘ (L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈) = Hom
    (cat_Funct α (c ↓CF 𝔎) 𝔄)
    (cf_map (cf_const (c ↓CF 𝔎) 𝔄 a)) 
    (cf_map (𝔗 ∘CF c O⨅CF 𝔎))"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ
    by (rule assms(3))
  from assms(2,4) show ?thesis
    by 
      (
        cs_concl 
          cs_simp: cat_Kan_cs_simps L_10_5_χ'_arrow_ArrVal_vdomain 
          cs_intro: cat_cs_intros
      )
qed

lemma L_10_5_χ'_arrow_ArrVal_app'[cat_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and τ'_def: "τ' = ntcf_arrow τ"
    and τ: "τ : a <CF.cone 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇τ'⦈ =
    ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ' a)"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret τ: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› τ
    by (rule assms(4))
  from assms(2,5) have "τ' ∈∘ cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
    unfolding τ'_def
    by
      (
        cs_concl
          cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
          cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
      )
  then show
    "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇τ'⦈ =
      ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ' a)"
    unfolding L_10_5_χ'_arrow_components by auto
qed


subsubsection‹‹L_10_5_χ'_arrow› is an isomorphism in the category ‹Set››

lemma L_10_5_χ'_arrow_is_arr_isomorphism: 
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a :
    cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈ ↦isocat_Set β
    L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈" (*FIXME: any reason not to evaluate ObjMap*)
    (
      is 
        ‹
          ?L_10_5_χ'_arrow :
            cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈ ↦isocat_Set β 
            ?L_10_5_N⦇ObjMap⦈⦇a⦈
        ›
    )
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
  let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓CF 𝔎) 𝔄›
  let ?H_ℭ = ‹λc. HomO.Cαℭ(c,-)›
  let ?H_𝔄 = ‹λc. HomO.Cα𝔄(a,-)›

  from assms(1,2) interpret β: 𝒵 β by simp 

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))

  from 𝔎.vempty_is_zet assms interpret c𝔎: tiny_category α ‹c ↓CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(2,6) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from 𝔎.vempty_is_zet assms interpret Πc: 
    is_tm_functor α ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)

  from assms(2) interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  have 𝔗Π: "𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦C.tmα 𝔄"
    by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)

  from assms(5,6) have [cat_cs_simps]: 
    "cf_of_cf_map (c ↓CF 𝔎) 𝔄 (cf_map (cf_const (c ↓CF 𝔎) 𝔄 a)) =
      cf_const (c ↓CF 𝔎) 𝔄 a"
    "cf_of_cf_map (c ↓CF 𝔎) 𝔄 (cf_map (𝔗 ∘CF c O⨅CF 𝔎)) = 𝔗 ∘CF c O⨅CF 𝔎"
    "cf_of_cf_map 𝔅 (cat_Set α) (cf_map (HomO.Cαℭ(c,-) ∘CF 𝔎)) = 
      HomO.Cαℭ(c,-) ∘CF 𝔎"
    "cf_of_cf_map 𝔅 (cat_Set α) (cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗)) = 
      HomO.Cα𝔄(a,-) ∘CF 𝔗"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+

  note cf_Cone_ObjMap_app = is_tm_functor.cf_Cone_ObjMap_app[OF 𝔗Π assms(1,2,6)]

  show ?thesis
  proof
    (
      intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI, 
      unfold L_10_5_χ'_arrow_components(3) cf_Cone_ObjMap_app
    )
    show "vfsequence ?L_10_5_χ'_arrow" 
      unfolding L_10_5_χ'_arrow_def by auto
    show χ'_arrow_ArrVal_vsv: "vsv (?L_10_5_χ'_arrow⦇ArrVal⦈)" 
      unfolding L_10_5_χ'_arrow_components by auto
    show "vcard ?L_10_5_χ'_arrow = 3ℕ"
      unfolding L_10_5_χ'_arrow_def by (simp add: nat_omega_simps)
    show [cat_cs_simps]: 
      "𝒟∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) = ?L_10_5_χ'_arrow⦇ArrDom⦈"
      unfolding L_10_5_χ'_arrow_components by simp
    show vrange_χ'_arrow_vsubset_N'': 
      "ℛ∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) ⊆∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
      unfolding L_10_5_χ'_arrow_components
    proof(rule vrange_VLambda_vsubset)
      fix τ assume prems: "τ ∈∘ cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
      from this assms c𝔎_𝔄.category_axioms have τ_is_arr:
        "τ : cf_map (cf_const (c ↓CF 𝔎) 𝔄 a) ↦?c𝔎_𝔄 cf_map (𝔗 ∘CF c O⨅CF 𝔎)"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_Kan_cs_simps cat_Funct_components(1)
              cs_intro: cat_small_cs_intros
          )
      note τ = cat_Funct_is_arrD(1,2)[OF τ_is_arr, unfolded cat_cs_simps]
      have "cf_of_cf_map (c ↓CF 𝔎) 𝔄 (cf_map (𝔗 ∘CF c O⨅CF 𝔎)) = 𝔗 ∘CF c O⨅CF 𝔎"
        by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
      from prems assms τ(1) show 
        "ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a) ∈∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
        by (subst τ(2)) (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro: 
                is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
          )
    qed

    show "ℛ∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) = ?L_10_5_N⦇ObjMap⦈⦇a⦈"
    proof
      (
        intro vsubset_antisym[OF vrange_χ'_arrow_vsubset_N''], 
        intro vsubsetI
      )

      fix υτa assume "υτa ∈∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
      from this assms have υτa:
        "υτa : cf_map (?H_ℭ c ∘CF 𝔎) ↦?FUNCT 𝔅 cf_map (?H_𝔄 a ∘CF 𝔗)"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )
      note υτa = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
      interpret τ: 
        is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹L_10_5_τ 𝔗 𝔎 c υτa a›
        by (rule L_10_5_τ_is_cat_cone[OF assms(3,4,5) υτa(2,1) assms(6)])

      show "υτa ∈∘ ℛ∘ (?L_10_5_χ'_arrow⦇ArrVal⦈)"
      proof(rule vsv.vsv_vimageI2')
        show "vsv (?L_10_5_χ'_arrow⦇ArrVal⦈)" by (rule χ'_arrow_ArrVal_vsv)
        from τ.is_cat_cone_axioms assms show
          "ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa a) ∈∘ 𝒟∘ (?L_10_5_χ'_arrow⦇ArrVal⦈)"
          by
            (
              cs_concl
                cs_simp: cat_Kan_cs_simps 
                cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
        from assms υτa(1,2) show 
          "υτa = ?L_10_5_χ'_arrow⦇ArrVal⦈⦇ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa a)⦈"
          by 
            (
              subst υτa(2), 
              cs_concl_step υτa_def[OF assms(3,4,5) υτa(2,1) assms(6)]  
            )
            (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed
    qed

    from assms show "?L_10_5_χ'_arrow⦇ArrDom⦈ ∈∘ Vset β"
      by (intro Vset_trans[OF _ Vset_in_mono[OF assms(2)]])
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_Funct_components(1) cf_Cone_ObjMap_app
            cs_intro: 
              cat_small_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros 
              c𝔎_𝔄.cat_Hom_in_Vset
        )
    with assms(2) have "?L_10_5_χ'_arrow⦇ArrDom⦈ ∈∘ Vset β"
      by (meson Vset_in_mono Vset_trans)
    from assms show "?L_10_5_N⦇ObjMap⦈⦇a⦈ ∈∘ Vset β"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
        )
    show dom_χ'_arrow: "𝒟∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) =
      Hom ?c𝔎_𝔄 (cf_map (cf_const (c ↓CF 𝔎) 𝔄 a)) (cf_map (𝔗 ∘CF c O⨅CF 𝔎))"
      unfolding L_10_5_χ'_arrow_components cf_Cone_ObjMap_app by simp
    show "?L_10_5_χ'_arrow⦇ArrDom⦈ = 
      Hom ?c𝔎_𝔄 (cf_map (cf_const (c ↓CF 𝔎) 𝔄 a)) (cf_map (𝔗 ∘CF c O⨅CF 𝔎))"
      unfolding L_10_5_χ'_arrow_components cf_Cone_ObjMap_app by simp
    show "v11 (?L_10_5_χ'_arrow⦇ArrVal⦈)"
    proof(rule vsv.vsv_valeq_v11I, unfold dom_χ'_arrow in_Hom_iff)
      fix τ' τ'' assume prems: 
        "τ' : cf_map (cf_const (c ↓CF 𝔎) 𝔄 a) ↦?c𝔎_𝔄 cf_map (𝔗 ∘CF c O⨅CF 𝔎)"
        "τ'' : cf_map (cf_const (c ↓CF 𝔎) 𝔄 a) ↦?c𝔎_𝔄 cf_map (𝔗 ∘CF c O⨅CF 𝔎)"
        "?L_10_5_χ'_arrow⦇ArrVal⦈⦇τ'⦈ = ?L_10_5_χ'_arrow⦇ArrVal⦈⦇τ''⦈"
      note τ' = cat_Funct_is_arrD[OF prems(1), unfolded cat_cs_simps]
        and τ'' = cat_Funct_is_arrD[OF prems(2), unfolded cat_cs_simps]
      interpret τ': is_cat_cone 
        α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'›
        by (rule is_cat_coneI[OF τ'(1) assms(6)])
      interpret τ'': is_cat_cone 
        α a ‹c ↓CF 𝔎› 𝔄 ‹𝔗 ∘CF c O⨅CF 𝔎› ‹ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ''›
        by (rule is_cat_coneI[OF τ''(1) assms(6)])
      have τ'τ': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ') = τ'"
        by (subst (2) τ'(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
      have τ''τ'': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'') = τ''"
        by (subst (2) τ''(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
      from prems(3) τ'(1) τ''(1) assms have
        "L_10_5_υ α 𝔗 𝔎 c τ' a = L_10_5_υ α 𝔗 𝔎 c τ'' a"
        by (subst (asm) τ'(2), use nothing in ‹subst (asm) τ''(2)›) (*slow*)
          (
            cs_prems 
              cs_simp: τ'τ' τ''τ'' cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
          )
      from this have υτ'a_υτ''a: 
        "L_10_5_υ α 𝔗 𝔎 c τ' a⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈ =
          L_10_5_υ α 𝔗 𝔎 c τ'' a⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈" 
        if "b ∈∘ 𝔅⦇Obj⦈" and "f : c ↦ℭ (𝔎⦇ObjMap⦈⦇b⦈)" for b f
        by simp
      have [cat_cs_simps]: "τ'⦇NTMap⦈⦇0, b, f⦈∙ = τ''⦇NTMap⦈⦇0, b, f⦈∙"
        if "b ∈∘ 𝔅⦇Obj⦈" and "f : c ↦ℭ (𝔎⦇ObjMap⦈⦇b⦈)" for b f
        using υτ'a_υτ''a[OF that] that
        by
          (
            cs_prems
              cs_simp: cat_Kan_cs_simps L_10_5_υ_arrow_ArrVal_app
              cs_intro: cat_cs_intros 
          )
      have
        "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ' =
          ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ''"
      proof(rule ntcf_eqI)
        show "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ' :
          cf_const (c ↓CF 𝔎) 𝔄 a ↦CF 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
          by (rule τ'.is_ntcf_axioms)
        then have dom_lhs: 
          "𝒟∘ (ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)
        show "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'' :
          cf_const (c ↓CF 𝔎) 𝔄 a ↦CF 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
          by (rule τ''.is_ntcf_axioms)
        then have dom_rhs: 
          "𝒟∘ (ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ''⦇NTMap⦈) = c ↓CF 𝔎⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)
        show
          "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'⦇NTMap⦈ =
            ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ''⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix A assume "A ∈∘ c ↓CF 𝔎⦇Obj⦈"
          with assms(5) obtain b f 
            where A_def: "A = [0, b, f]∘"
              and b: "b ∈∘ 𝔅⦇Obj⦈"
              and f: "f : c ↦ℭ 𝔎⦇ObjMap⦈⦇b⦈"
            by auto
          from b f show 
            "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ'⦇NTMap⦈⦇A⦈ =
              ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 τ''⦇NTMap⦈⦇A⦈"
            unfolding A_def 
            by (cs_concl cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
        qed (cs_concl cs_intro: V_cs_intros)+
      qed simp_all
      then show "τ' = τ''"
      proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
        show "τ' ∈∘ ntcf_arrows α (c ↓CF 𝔎) 𝔄"
          by (subst τ'(2))
            (
              cs_concl cs_intro:
                cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
        show "τ'' ∈∘ ntcf_arrows α (c ↓CF 𝔎) 𝔄"
          by (subst τ''(2))
            (
              cs_concl cs_intro: 
                cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
      qed
    qed (cs_concl cs_intro: cat_Kan_cs_intros)

  qed auto

qed

lemma L_10_5_χ'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]: 
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
    and "B = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
    and "ℭ' = cat_Set β"
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a : A ↦isoℭ' B"
  using assms(1-6)
  unfolding assms(7-9) 
  by (rule L_10_5_χ'_arrow_is_arr_isomorphism)

lemma L_10_5_χ'_arrow_is_arr: 
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a :
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈ ↦cat_Set β
      L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
    by 
      (
        rule cat_Set_is_arr_isomorphismD(1)[
          OF L_10_5_χ'_arrow_is_arr_isomorphism[OF assms(1-6)]
          ]
      )

lemma L_10_5_χ'_arrow_is_arr'[cat_Kan_cs_intros]: 
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)⦇ObjMap⦈⦇a⦈"
    and "B = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
    and "ℭ' = cat_Set β"
  shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a : A ↦ℭ' B"
  using assms(1-6) unfolding assms(7-9) by (rule L_10_5_χ'_arrow_is_arr)



subsection‹Lemma X.5: ‹L_10_5_χ›\label{sec:lem_X_5_end}›


subsubsection‹Definition and elementary properties›

definition L_10_5_χ :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "L_10_5_χ α β 𝔗 𝔎 c =
    [
      (λa∈∘𝔗⦇HomCod⦈⦇Obj⦈. L_10_5_χ'_arrow α β 𝔗 𝔎 c a),
      cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎),
      L_10_5_N α β 𝔗 𝔎 c,
      op_cat (𝔗⦇HomCod⦈),
      cat_Set β
    ]∘"


text‹Components.›

lemma L_10_5_χ_components: 
  shows "L_10_5_χ α β 𝔗 𝔎 c⦇NTMap⦈ = 
    (λa∈∘𝔗⦇HomCod⦈⦇Obj⦈. L_10_5_χ'_arrow α β 𝔗 𝔎 c a)"
    and [cat_Kan_cs_simps]: 
      "L_10_5_χ α β 𝔗 𝔎 c⦇NTDom⦈ = cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎)"
    and [cat_Kan_cs_simps]: 
      "L_10_5_χ α β 𝔗 𝔎 c⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c"
    and "L_10_5_χ α β 𝔗 𝔎 c⦇NTDGDom⦈ = op_cat (𝔗⦇HomCod⦈)"
    and [cat_Kan_cs_simps]: "L_10_5_χ α β 𝔗 𝔎 c⦇NTDGCod⦈ = cat_Set β"
  unfolding L_10_5_χ_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔅 𝔗
  assumes 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_χ_components' =
  L_10_5_χ_components[where 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = L_10_5_χ_components'(4)

end


subsubsection‹Natural transformation map›

mk_VLambda L_10_5_χ_components(1)
  |vsv L_10_5_χ_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes α 𝔄 𝔅 𝔗
  assumes 𝔗: "𝔗 : 𝔅 ↦↦Cα 𝔄"
begin

interpretation is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda L_10_5_χ_components(1)[where 𝔗=𝔗, unfolded cat_cs_simps]
  |vdomain L_10_5_χ_NTMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_χ_NTMap_app[cat_Kan_cs_simps]|

end


subsubsection‹‹L_10_5_χ› is a natural isomorphism›

lemma L_10_5_χ_is_iso_ntcf:
  ―‹See lemma on page 245 in \cite{mac_lane_categories_2010}.›
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "L_10_5_χ α β 𝔗 𝔎 c :
    cf_Cone α β (𝔗 ∘CF c O⨅CF 𝔎) ↦CF.iso L_10_5_N α β 𝔗 𝔎 c :
    op_cat 𝔄 ↦↦Cβ cat_Set β"
    (is ‹?L_10_5_χ : ?cf_Cone ↦CF.iso ?L_10_5_N : op_cat 𝔄 ↦↦Cβ cat_Set β›)
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
  let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓CF 𝔎) 𝔄›
  let ?ntcf_c𝔎_𝔄 = ‹ntcf_const (c ↓CF 𝔎) 𝔄›
  let ?𝔗_c𝔎 = ‹𝔗 ∘CF c O⨅CF 𝔎›
  let ?H_ℭ = ‹λc. HomO.Cαℭ(c,-)›
  let ?H_𝔄 = ‹λa. HomO.Cα𝔄(a,-)›
  let ?L_10_5_χ'_arrow = ‹L_10_5_χ'_arrow α β 𝔗 𝔎 c›
  let ?cf_c𝔎_𝔄 = ‹cf_const (c ↓CF 𝔎) 𝔄›
  let ?L_10_5_υ = ‹L_10_5_υ α 𝔗 𝔎 c›
  let ?L_10_5_υ_arrow = ‹L_10_5_υ_arrow 𝔗 𝔎 c›

  interpret β: 𝒵 β by (rule assms(1))

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))

  from 𝔎.vempty_is_zet assms(5) interpret c𝔎: tiny_category α ‹c ↓CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(2,5) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret β_c𝔎_𝔄: category β ?c𝔎_𝔄
    by (rule c𝔎_𝔄.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros assms(2))+
  from assms(2,5) interpret Δ: is_functor α 𝔄 ?c𝔎_𝔄 ‹ΔC α (c ↓CF 𝔎) 𝔄›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms assms(2) interpret βΔ: 
    is_functor β 𝔄 ?c𝔎_𝔄 ‹ΔC α (c ↓CF 𝔎) 𝔄›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from 𝔎.vempty_is_zet assms(5) interpret Πc: 
    is_tm_functor α ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret βΠc: is_tiny_functor β ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by (rule Πc.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])
  
  interpret E: is_functor β ‹?FUNCT ℭ ×C ℭ› ‹cat_Set β› ‹cf_eval α β ℭ›
    by (rule 𝔎.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])

  from assms(2) interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret β𝔄: tiny_category β 𝔄
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
  interpret β𝔅: tiny_category β 𝔅
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
  interpret βℭ: tiny_category β ℭ
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+

  interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
  interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+

  interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
    by (rule 𝔎.subcategory_cat_Set_cat_Set[OF assms(1,2)])
  
  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)

    show "vfsequence (?L_10_5_χ)" unfolding L_10_5_χ_def by auto
    show "vcard (?L_10_5_χ) = 5ℕ" 
      unfolding L_10_5_χ_def by (simp add: nat_omega_simps)
    from assms(2) show "?cf_Cone : op_cat 𝔄 ↦↦Cβ cat_Set β" 
      by (intro is_tm_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
        (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+

    from assms show "?L_10_5_N : op_cat 𝔄 ↦↦Cβ cat_Set β" 
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    show "?L_10_5_χ⦇NTMap⦈⦇a⦈ : 
      ?cf_Cone⦇ObjMap⦈⦇a⦈ ↦isocat_Set β ?L_10_5_N⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ 𝔄⦇Obj⦈" for a 
      using assms(2,3,4,5) that
      by
        (
          cs_concl 
            cs_simp: L_10_5_χ_NTMap_app 
            cs_intro: cat_cs_intros L_10_5_χ'_arrow_is_arr_isomorphism
         )
    from cat_Set_is_arr_isomorphismD[OF this] show 
      "?L_10_5_χ⦇NTMap⦈⦇a⦈ : ?cf_Cone⦇ObjMap⦈⦇a⦈ ↦cat_Set β ?L_10_5_N⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ 𝔄⦇Obj⦈" for a
      using that by auto

    have [cat_cs_simps]:
      "?L_10_5_χ'_arrow b ∘Acat_Set β
        cf_hom ?c𝔎_𝔄 [ntcf_arrow (?ntcf_c𝔎_𝔄 f), ntcf_arrow (ntcf_id ?𝔗_c𝔎)]∘ =
        cf_hom (?FUNCT 𝔅)
          [
            ntcf_arrow (ntcf_id (?H_ℭ c ∘CF 𝔎)),
            ntcf_arrow (HomA.Cα𝔄(f,-) ∘NTCF-CF 𝔗)
          ]∘ ∘Acat_Set β ?L_10_5_χ'_arrow a"
      (
        is 
          "?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs =
            ?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a"
      )
      if "f : b ↦𝔄 a" for a b f
    proof-
      let ?H_f = ‹HomA.Cα𝔄(f,-)›
      from that assms β_c𝔎_𝔄.category_axioms c𝔎_𝔄.category_axioms have lhs:
        "?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs :
          Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎) ↦cat_Set β
          ?L_10_5_N⦇ObjMap⦈⦇b⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp:
                cat_Kan_cs_simps
                cat_cs_simps
                cat_FUNCT_cs_simps
                cat_Funct_components(1)
                cat_op_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_FUNCT_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_op_intros
          )
      then have dom_lhs:
        "𝒟∘ ((?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈) =
          Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎)"
        by (cs_concl cs_simp: cat_cs_simps)
      from that assms β_c𝔎_𝔄.category_axioms c𝔎_𝔄.category_axioms have rhs:
        "?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a :
          Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎) ↦cat_Set β
          ?L_10_5_N⦇ObjMap⦈⦇b⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: 
                cat_Kan_cs_simps 
                cat_cs_simps
                cat_Funct_components(1)
                cat_op_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros
                cat_op_intros
          )
      then have dom_rhs:
        "𝒟∘ ((?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a)⦇ArrVal⦈) =
          Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎)"
        by (cs_concl cs_simp: cat_cs_simps)

      show ?thesis
      proof(rule arr_Set_eqI)
        from lhs show arr_Set_lhs: 
          "arr_Set β (?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs)"
          by (auto dest: cat_Set_is_arrD(1))
        from rhs show arr_Set_rhs:
          "arr_Set β (?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a)"
          by (auto dest: cat_Set_is_arrD(1))
        show 
          "(?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈ =
            (?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a)⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix F assume prems: "F : cf_map (?cf_c𝔎_𝔄 a) ↦?c𝔎_𝔄 cf_map ?𝔗_c𝔎"
          let ?F = ‹ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 F›
          from that have [cat_cs_simps]:
            "cf_of_cf_map (c ↓CF 𝔎) 𝔄 (cf_map (?cf_c𝔎_𝔄 a)) = ?cf_c𝔎_𝔄 a"
            "cf_of_cf_map (c ↓CF 𝔎) 𝔄 (cf_map (?𝔗_c𝔎)) = ?𝔗_c𝔎"
            by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
          note F = cat_Funct_is_arrD[OF prems, unfolded cat_cs_simps]
          from that F(1) have F_const_is_cat_cone:
            "?F ∙NTCF ?ntcf_c𝔎_𝔄 f : b <CF.cone ?𝔗_c𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps
                  cs_intro: cat_small_cs_intros is_cat_coneI cat_cs_intros
              )
          have [cat_cs_simps]:
            "?L_10_5_υ (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b =
              ?H_f ∘NTCF-CF 𝔗 ∙NTCF ?L_10_5_υ (ntcf_arrow ?F) a"
          proof(rule ntcf_eqI)
            from assms that F(1) show
              "?L_10_5_υ (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b :
                ?H_ℭ c ∘CF 𝔎 ↦CF ?H_𝔄 b ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
              by
                (
                  cs_concl cs_intro:
                    cat_small_cs_intros 
                    cat_Kan_cs_intros 
                    cat_cs_intros 
                    is_cat_coneI
                )
            then have dom_υ: 
              "𝒟∘ (?L_10_5_υ (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈) = 
                𝔅⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            from assms that F(1) show 
              "?H_f ∘NTCF-CF 𝔗 ∙NTCF ?L_10_5_υ (ntcf_arrow ?F) a :
                ?H_ℭ c ∘CF 𝔎 ↦CF ?H_𝔄 b ∘CF 𝔗 : 𝔅 ↦↦Cα cat_Set α"
              by
                (
                  cs_concl cs_intro:
                    cat_Kan_cs_intros cat_cs_intros is_cat_coneI
                )
            then have dom_f𝔗υ:
              "𝒟∘ ((?H_f ∘NTCF-CF 𝔗 ∙NTCF ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈) =
                𝔅⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            show 
              "?L_10_5_υ (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈ =
                (?H_f ∘NTCF-CF 𝔗 ∙NTCF ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_υ dom_f𝔗υ)
              fix b' assume prems': "b' ∈∘ 𝔅⦇Obj⦈"
              let ?Y = ‹Yoneda_component (?H_𝔄 b) a f (𝔗⦇ObjMap⦈⦇b'⦈)›
              let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
              let ?𝔗b' = ‹𝔗⦇ObjMap⦈⦇b'⦈›
              have [cat_cs_simps]:
                "?L_10_5_υ_arrow (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b b' =
                  ?Y ∘Acat_Set α ?L_10_5_υ_arrow (ntcf_arrow ?F) a b'"
                (is ‹?υ_Ffbb' = ?Yυ›)
              proof-
                from assms prems' F_const_is_cat_cone have υ_Ffbb': 
                  "?υ_Ffbb' : Hom ℭ c ?𝔎b' ↦cat_Set α Hom 𝔄 b ?𝔗b'"
                  by 
                    (
                      cs_concl cs_intro:
                        cat_cs_intros L_10_5_υ_arrow_is_arr
                    )
                then have dom_υ_Ffbb': "𝒟∘ (?υ_Ffbb'⦇ArrVal⦈) = Hom ℭ c (?𝔎b')"
                  by (cs_concl cs_simp: cat_cs_simps)
                from assms that 𝔗.HomCod.category_axioms prems' F(1) have Yυ:
                  "?Yυ : Hom ℭ c ?𝔎b' ↦cat_Set α Hom 𝔄 b ?𝔗b'"
                  by
                    (
                      cs_concl
                        cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
                        cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                    )
                then have dom_Yυ: "𝒟∘ (?Yυ⦇ArrVal⦈) = Hom ℭ c (?𝔎b')"
                  by (cs_concl cs_simp: cat_cs_simps)
                show ?thesis
                proof(rule arr_Set_eqI)
                  from υ_Ffbb' show arr_Set_υ_Ffbb': "arr_Set α ?υ_Ffbb'"
                    by (auto dest: cat_Set_is_arrD(1))
                  from Yυ show arr_Set_Yυ: "arr_Set α ?Yυ"
                    by (auto dest: cat_Set_is_arrD(1))
                  show "?υ_Ffbb'⦇ArrVal⦈ = ?Yυ⦇ArrVal⦈"
                  proof(rule vsv_eqI, unfold dom_υ_Ffbb' dom_Yυ in_Hom_iff)
                    fix g assume "g : c ↦ℭ ?𝔎b'"
                    with 
                      assms(2-) 
                      𝔎.is_functor_axioms 
                      𝔗.is_functor_axioms 
                      𝔗.HomCod.category_axioms 
                      𝔎.HomCod.category_axioms 
                      that prems' F(1) 
                    show "?υ_Ffbb'⦇ArrVal⦈⦇g⦈ = ?Yυ⦇ArrVal⦈⦇g⦈"
                      by (*slow*)
                        (
                          cs_concl
                            cs_simp:
                              cat_Kan_cs_simps
                              cat_cs_simps
                              L_10_5_υ_arrow_ArrVal_app
                              cat_comma_cs_simps
                              cat_op_simps
                            cs_intro: 
                              cat_Kan_cs_intros 
                              is_cat_coneI 
                              cat_cs_intros 
                              cat_comma_cs_intros
                              cat_op_intros 
                            cs_simp: cat_FUNCT_cs_simps
                            cs_intro: cat_small_cs_intros
                        )
                  qed (use arr_Set_υ_Ffbb' arr_Set_Yυ in auto)
                qed (use υ_Ffbb' Yυ in ‹cs_concl cs_simp: cat_cs_simps›)+
              qed

              from assms prems' that F(1) show
                "?L_10_5_υ (ntcf_arrow (?F ∙NTCF ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈⦇b'⦈ =
                  (?H_f ∘NTCF-CF 𝔗 ∙NTCF ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈⦇b'⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_Kan_cs_simps cat_cs_simps
                      cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                  )

            qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+

          qed simp_all

          from that F(1) interpret F: is_cat_cone α a ‹c ↓CF 𝔎› 𝔄 ‹?𝔗_c𝔎› ?F
            by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
          from
            assms(2-) prems F(1) that
            𝔗.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that] (*speedup*)
            β_c𝔎_𝔄.category_axioms (*speedup*)
          show 
            "(?L_10_5_χ'_arrow b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈⦇F⦈ =
              (?cf_hom_rhs ∘Acat_Set β ?L_10_5_χ'_arrow a)⦇ArrVal⦈⦇F⦈"
            by (subst (1 2) F(2)) (*exceptionally slow*)
            (
              cs_concl
                cs_simp: 
                  cat_cs_simps 
                  cat_Kan_cs_simps
                  cat_FUNCT_cs_simps 
                  cat_Funct_components(1) 
                  cat_op_simps 
                cs_intro: 
                  cat_small_cs_intros 
                  is_cat_coneI 
                  cat_Kan_cs_intros
                  cat_cs_intros 
                  cat_prod_cs_intros 
                  cat_FUNCT_cs_intros 
                  cat_op_intros
            )
        qed (use arr_Set_lhs arr_Set_rhs in auto)

      qed (use lhs rhs in ‹cs_concl cs_simp: cat_cs_simps›)+

    qed

    show 
      "?L_10_5_χ⦇NTMap⦈⦇b⦈ ∘Acat_Set β ?cf_Cone⦇ArrMap⦈⦇f⦈ =
        ?L_10_5_N⦇ArrMap⦈⦇f⦈ ∘Acat_Set β ?L_10_5_χ⦇NTMap⦈⦇a⦈"
      if "f : b ↦𝔄 a" for a b f
      using that assms
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_Kan_cs_simps
              cat_Funct_components(1)
              cat_FUNCT_cs_simps
              cat_op_simps
            cs_intro: 
              cat_small_cs_intros
              cat_Kan_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros
              cat_op_intros
        )

  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed



subsection‹
The limit of ‹𝔗 ∘CF c O⨅CF 𝔎› exists for every 
pointwise right Kan extension of ‹𝔗› along ‹𝔎›
›

lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
  ―‹Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.
    The size conditions for the functors ‹𝔎› and ‹𝔗› are related to the
    choice of the definition of the limit in this work (by definition,
    all limits are small).›
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  obtains UA 
    where "UA : 𝔊⦇ObjMap⦈⦇c⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
proof-

  define β where "β = α + ω"
  have β: "𝒵 β" and αβ: "α ∈∘ β" 
    by (simp_all add: β_def AG.𝒵_Limit_αω AG.𝒵_ω_αω 𝒵_def AG.𝒵_α_αω)
  then interpret β: 𝒵 β by simp 

  let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
  let ?H_A = ‹λf. HomA.Cα𝔄(f,-)›
  let ?H_A𝔊 = ‹λf. ?H_A f ∘NTCF-CF 𝔊›
  let ?H_𝔄 = ‹λa. HomO.Cα𝔄(a,-)›
  let ?H_𝔄𝔗 = ‹λa. ?H_𝔄 a ∘CF 𝔗›
  let ?H_𝔄𝔊 = ‹λa. ?H_𝔄 a ∘CF 𝔊›
  let ?H_ℭ = ‹λc. HomO.Cαℭ(c,-)›
  let ?H_ℭ𝔎 = ‹λc. ?H_ℭ c ∘CF 𝔎›
  let ?H_𝔄ε = ‹λb. ?H_𝔄 b ∘CF-NTCF ε›
  let ?SET_𝔎 = ‹exp_cat_cf α (cat_Set α) 𝔎›
  let ?H_FUNCT = ‹λℭ 𝔉. HomO.Cβ?FUNCT ℭ(-,cf_map 𝔉)›
  let ?ua_NTDGDom = ‹op_cat (?FUNCT ℭ)›
  let ?ua_NTDom = ‹λa. ?H_FUNCT ℭ (?H_𝔄𝔊 a)›
  let ?ua_NTCod = ‹λa. ?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘CF op_cf ?SET_𝔎›
  let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓CF 𝔎) 𝔄›
  let ?ua = 
    ‹
      λa. ntcf_ua_fo
        β
        ?SET_𝔎
        (cf_map (?H_𝔄𝔗 a))
        (cf_map (?H_𝔄𝔊 a))
        (ntcf_arrow (?H_𝔄ε a))
    ›
  let ?cf_nt = ‹cf_nt α β (cf_id ℭ)›
  let ?cf_eval = ‹cf_eval α β ℭ›
  let ?𝔗_c𝔎 = ‹𝔗 ∘CF c O⨅CF 𝔎›
  let ?cf_c𝔎_𝔄 = ‹cf_const (c ↓CF 𝔎) 𝔄›
  let ?𝔊c = ‹𝔊⦇ObjMap⦈⦇c⦈›
  let ?Δ = ‹ΔC α (c ↓CF 𝔎) 𝔄›
  let ?ntcf_ua_fo = 
    ‹
      λa. ntcf_ua_fo
        β 
        ?SET_𝔎 
        (cf_map (?H_𝔄𝔗 a)) 
        (cf_map (?H_𝔄𝔊 a)) 
        (ntcf_arrow (?H_𝔄ε a))
    ›
  let ?umap_fo =
    ‹
      λb. umap_fo
        ?SET_𝔎
        (cf_map (?H_𝔄𝔗 b))
        (cf_map (?H_𝔄𝔊 b))
        (ntcf_arrow (?H_𝔄ε b))
        (cf_map (?H_ℭ c))
    ›

  interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))

  from AG.vempty_is_zet assms(3) interpret c𝔎: tiny_category α ‹c ↓CF 𝔎›
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from αβ assms(3) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret β_c𝔎_𝔄: category β ?c𝔎_𝔄
    by (rule c𝔎_𝔄.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros αβ)+
  from αβ assms(3) interpret Δ: is_functor α 𝔄 ?c𝔎_𝔄 ?Δ
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Δ.is_functor_axioms αβ interpret βΔ: 
    is_functor β 𝔄 ‹?c𝔎_𝔄› ‹?Δ›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from AG.vempty_is_zet assms(3) interpret Πc: 
    is_tm_functor α ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret βΠc: is_tiny_functor β ‹c ↓CF 𝔎› 𝔅 ‹c O⨅CF 𝔎›
    by (rule Πc.cf_is_tiny_functor_if_ge_Limit[OF β αβ])
  
  interpret E: is_functor β ‹?FUNCT ℭ ×C ℭ› ‹cat_Set β› ?cf_eval
    by (rule AG.HomCod.cat_cf_eval_is_functor[OF β αβ])

  from αβ interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from αβ interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from αβ interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret β𝔄: tiny_category β 𝔄
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
  interpret β𝔅: tiny_category β 𝔅
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
  interpret βℭ: tiny_category β ℭ
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+

  interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
  interpret β𝔊: is_tiny_functor β ℭ 𝔄 𝔊
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
  interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+

  interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
    by (rule AG.subcategory_cat_Set_cat_Set[OF β αβ])

  from assms(3) αβ interpret Hom_c: is_functor α ℭ ‹cat_Set α› ‹?H_ℭ c› 
    by (cs_concl cs_intro: cat_cs_intros)

  (** E' **)

  define E' :: V where "E' =
    [
      (λa∈∘𝔄⦇Obj⦈. ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙),
      (λf∈∘𝔄⦇Arr⦈. ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙),
      op_cat 𝔄,
      cat_Set β
    ]∘ "

  have E'_components:
    "E'⦇ObjMap⦈ = (λa∈∘𝔄⦇Obj⦈. ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙)"
    "E'⦇ArrMap⦈ =
      (λf∈∘𝔄⦇Arr⦈. ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙)"
    "E'⦇HomDom⦈ = op_cat 𝔄"
    "E'⦇HomCod⦈ = cat_Set β"
    unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = E'_components(3,4)
  
  have E'_ObjMap_app[cat_cs_simps]: 
    "E'⦇ObjMap⦈⦇a⦈ = ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding E'_components by simp
  have E'_ArrMap_app[cat_cs_simps]: 
    "E'⦇ArrMap⦈⦇f⦈ = ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙"
    if "f ∈∘ 𝔄⦇Arr⦈" for f
    using that unfolding E'_components by simp

  have E': "E' : op_cat 𝔄 ↦↦Cβ cat_Set β"
  proof(intro is_functorI')

    show "vfsequence E'" unfolding E'_def by auto
    show "vcard E' = 4ℕ" unfolding E'_def by (simp add: nat_omega_simps)
    show "vsv (E'⦇ObjMap⦈)" unfolding E'_components by simp
    show "vsv (E'⦇ArrMap⦈)" unfolding E'_components by simp
    show "𝒟∘ (E'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding E'_components by (simp add: cat_op_simps)
    show "ℛ∘ (E'⦇ObjMap⦈) ⊆∘ cat_Set β⦇Obj⦈"
      unfolding E'_components
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      then have "?H_𝔄𝔊 a : ℭ ↦↦Cα cat_Set α"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      with assms(3) prems show 
        "?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙ ∈∘ cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Set_components(1)
              cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
          )
    qed
    show "𝒟∘ (E'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
      unfolding E'_components by (simp add: cat_op_simps)
    show "E'⦇ArrMap⦈⦇f⦈ : E'⦇ObjMap⦈⦇a⦈ ↦cat_Set β E'⦇ObjMap⦈⦇b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
    proof-
      from that[unfolded cat_op_simps] assms(3) show ?thesis
        by (intro cat_Set_αβ.subcat_is_arrD)
          (
            cs_concl 
              cs_simp:
                category.cf_eval_ObjMap_app
                category.cf_eval_ArrMap_app
                E'_ObjMap_app
                E'_ArrMap_app
              cs_intro: cat_cs_intros
          )
    qed
    then have [cat_cs_intros]: "E'⦇ArrMap⦈⦇f⦈ : A ↦cat_Set β B"
      if "A = E'⦇ObjMap⦈⦇a⦈" and "B = E'⦇ObjMap⦈⦇b⦈" and "f : b ↦𝔄 a" 
      for a b f A B
      using that by (simp add: cat_op_simps)
    show
      "E'⦇ArrMap⦈⦇g ∘Aop_cat 𝔄 f⦈ = E'⦇ArrMap⦈⦇g⦈ ∘Acat_Set β E'⦇ArrMap⦈⦇f⦈"
      if "g : b ↦op_cat 𝔄 c" and "f : a ↦op_cat 𝔄 b" for b c g a f
    proof-
      note g = that(1)[unfolded cat_op_simps]
        and f = that(2)[unfolded cat_op_simps]
      from g f assms(3) αβ show ?thesis
        by 
          (
            cs_concl
              cs_intro:
                cat_small_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                E.cf_ArrMap_Comp[symmetric]
          )+
    qed
    
    show "E'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set β⦇CId⦈⦇E'⦇ObjMap⦈⦇a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof(cs_concl_step cat_Set_αβ.subcat_CId[symmetric])
      from that[unfolded cat_op_simps] assms(3) show 
        "E'⦇ObjMap⦈⦇a⦈ ∈∘ cat_Set α⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros
          )
      from that[unfolded cat_op_simps] assms(3) show 
        "E'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set α⦇CId⦈⦇E'⦇ObjMap⦈⦇a⦈⦈"
        by
          (
            cs_concl 
              cs_intro: cat_cs_intros
              cs_simp:
                cat_Set_components(1)
                cat_cs_simps
                cat_op_simps
                ntcf_id_cf_comp[symmetric]
          )
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  then interpret E': is_functor β ‹op_cat 𝔄› ‹cat_Set β› E' by simp


  (** N' **)

  define N' :: V where "N' =
    [
      (λa∈∘𝔄⦇Obj⦈. ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙),
      (λf∈∘𝔄⦇Arr⦈. ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙),
      op_cat 𝔄,
      cat_Set β
    ]∘ "

  have N'_components:
    "N'⦇ObjMap⦈ = (λa∈∘𝔄⦇Obj⦈. ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙)"
    "N'⦇ArrMap⦈ =
      (λf∈∘𝔄⦇Arr⦈. ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙)"
    "N'⦇HomDom⦈ = op_cat 𝔄"
    "N'⦇HomCod⦈ = cat_Set β"
    unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = N'_components(3,4)
  
  have N'_ObjMap_app[cat_cs_simps]: 
    "N'⦇ObjMap⦈⦇a⦈ = ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding N'_components by simp
  have N'_ArrMap_app[cat_cs_simps]: 
    "N'⦇ArrMap⦈⦇f⦈ = ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈∙"
    if "f ∈∘ 𝔄⦇Arr⦈" for f
    using that unfolding N'_components by simp

  from αβ interpret cf_nt_ℭ: is_functor β ‹?FUNCT ℭ ×C ℭ› ‹cat_Set β› ‹?cf_nt›
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  
  have N': "N' : op_cat 𝔄 ↦↦Cβ cat_Set β"
  proof(intro is_functorI')
    show "vfsequence N'" unfolding N'_def by simp
    show "vcard N' = 4ℕ" unfolding N'_def by (simp add: nat_omega_simps)
    show "vsv (N'⦇ObjMap⦈)" unfolding N'_components by simp
    show "vsv (N'⦇ArrMap⦈)" unfolding N'_components by simp
    show "𝒟∘ (N'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding N'_components by (simp add: cat_op_simps)
    show "ℛ∘ (N'⦇ObjMap⦈) ⊆∘ cat_Set β⦇Obj⦈"
      unfolding N'_components
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      with assms(3) αβ show 
        "?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙ ∈∘ cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps  
              cs_intro: cat_cs_intros FUNCT_ℭ.cat_Hom_in_Vset cat_FUNCT_cs_intros
          )
    qed
    show "𝒟∘ (N'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈" 
      unfolding N'_components by (simp add: cat_op_simps)
    show "N'⦇ArrMap⦈⦇f⦈ : N'⦇ObjMap⦈⦇a⦈ ↦cat_Set β N'⦇ObjMap⦈⦇b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
      using that[unfolded cat_op_simps] assms(3)
      by 
        (
          cs_concl 
            cs_simp: N'_ObjMap_app N'_ArrMap_app 
            cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
        )
    show 
      "N'⦇ArrMap⦈⦇g ∘Aop_cat 𝔄 f⦈ = N'⦇ArrMap⦈⦇g⦈ ∘Acat_Set β N'⦇ArrMap⦈⦇f⦈"
      if "g : b ↦op_cat 𝔄 c" and "f : a ↦op_cat 𝔄 b" for b c g a f
    proof-
      from that assms(3) αβ show ?thesis
        unfolding cat_op_simps
        by
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                cf_nt_ℭ.cf_ArrMap_Comp[symmetric]
          )
    qed
    show "N'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set β⦇CId⦈⦇N'⦇ObjMap⦈⦇a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof-
      note [cat_cs_simps] = 
        ntcf_id_cf_comp[symmetric] 
        ntcf_arrow_id_ntcf_id[symmetric]
        cat_FUNCT_CId_app[symmetric] 
      from that[unfolded cat_op_simps] assms(3) αβ show ?thesis
        by (*very slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
              cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps 
          )+
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  then interpret N': is_functor β ‹op_cat 𝔄› ‹cat_Set β› N' by simp


  (** Y' **)
  
  define Y' :: V where "Y' =
    [
      (λa∈∘𝔄⦇Obj⦈. ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙),
      N',
      E',
      op_cat 𝔄,
      cat_Set β
    ]∘"

  have Y'_components:
    "Y'⦇NTMap⦈ = (λa∈∘𝔄⦇Obj⦈. ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙)"
    "Y'⦇NTDom⦈ = N'"
    "Y'⦇NTCod⦈ = E'"
    "Y'⦇NTDGDom⦈ = op_cat 𝔄"
    "Y'⦇NTDGCod⦈ = cat_Set β"
    unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = Y'_components(2-5)

  have Y'_NTMap_app[cat_cs_simps]: 
    "Y'⦇NTMap⦈⦇a⦈ = ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈∙" 
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding Y'_components by simp

  from β αβ interpret Y: 
    is_iso_ntcf β ‹?FUNCT ℭ ×C ℭ› ‹cat_Set β› ?cf_nt ?cf_eval ‹ntcf_Yoneda α β ℭ›
    by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)

  have Y': "Y' : N' ↦CF.iso E' : op_cat 𝔄 ↦↦Cβ cat_Set β"
  proof(intro is_iso_ntcfI is_ntcfI')

    show "vfsequence Y'" unfolding Y'_def by simp
    show "vcard Y' = 5ℕ"
      unfolding Y'_def by (simp add: nat_omega_simps)
    show "vsv (Y'⦇NTMap⦈)" unfolding Y'_components by auto
    show "𝒟∘ (Y'⦇NTMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding Y'_components by (simp add: cat_op_simps)
    show Y'_NTMap_a: "Y'⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦isocat_Set β E'⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      using that[unfolded cat_op_simps] assms(3)
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro:
              cat_arrow_cs_intros
              cat_cs_intros
              cat_prod_cs_intros
              cat_FUNCT_cs_intros
        )
    then show "Y'⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦cat_Set β E'⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
    show
      "Y'⦇NTMap⦈⦇b⦈ ∘Acat_Set β N'⦇ArrMap⦈⦇f⦈ =
        E'⦇ArrMap⦈⦇f⦈ ∘Acat_Set β Y'⦇NTMap⦈⦇a⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
    proof-
      note f = that[unfolded cat_op_simps]
      from f assms(3) show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps Y.ntcf_Comp_commute 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )+      
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

  have E'_def: "E' = HomO.Cβ𝔄(-,?𝔊c)"
  proof(rule cf_eqI)
    show "E' : op_cat 𝔄 ↦↦Cβ cat_Set β"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms(3) show
      "HomO.Cβ𝔄(-,?𝔊c) : op_cat 𝔄 ↦↦Cβ cat_Set β"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have dom_lhs: "𝒟∘ (E'⦇ObjMap⦈) = 𝔄⦇Obj⦈" unfolding E'_components by simp
    from assms(3) have dom_rhs: 
      "𝒟∘ (HomO.Cβ𝔄(-,?𝔊c)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
      unfolding E'_components 
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    show "E'⦇ObjMap⦈ = HomO.Cβ𝔄(-,?𝔊c)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔄⦇Obj⦈"
      with assms(3) show "E'⦇ObjMap⦈⦇a⦈ = HomO.Cβ𝔄(-,?𝔊c)⦇ObjMap⦈⦇a⦈"
        by
          (
            cs_concl
              cs_simp: cat_op_simps cat_cs_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
    qed (auto simp: E'_components cat_cs_intros assms(3))

    have dom_lhs: "𝒟∘ (E'⦇ArrMap⦈) = 𝔄⦇Arr⦈" unfolding E'_components by simp
    from assms(3) have dom_rhs: 
      "𝒟∘ (HomO.Cβ𝔄(-,?𝔊c)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
      unfolding E'_components 
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    
    show "E'⦇ArrMap⦈ = HomO.Cβ𝔄(-,?𝔊c)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

      fix f assume prems: "f ∈∘ 𝔄⦇Arr⦈"
      then obtain a b where f: "f : a ↦𝔄 b" by auto
      have [cat_cs_simps]:
        "cf_eval_arrow ℭ (ntcf_arrow (?H_A𝔊 f)) (ℭ⦇CId⦈⦇c⦈) =
          cf_hom 𝔄 [f, 𝔄⦇CId⦈⦇?𝔊c⦈]∘"
        (is ‹?cf_eval_arrow = ?cf_hom_f𝔊c›)
      proof-
        have cf_eval_arrow_f_CId_𝔊c:
          "?cf_eval_arrow :
            Hom 𝔄 b ?𝔊c ↦cat_Set α Hom 𝔄 a ?𝔊c"
        proof(rule cf_eval_arrow_is_arr')
          from f show "?H_A𝔊 f :
            ?H_𝔄𝔊 b ↦CF ?H_𝔄𝔊 a : ℭ ↦↦Cα cat_Set α"
            by (cs_concl cs_intro: cat_cs_intros)
        qed
          (
            use f assms(3) in
              ‹
                cs_concl
                  cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
              ›
          )+
        from f assms(3) have dom_lhs:
          "𝒟∘ (?cf_eval_arrow⦇ArrVal⦈) = Hom 𝔄 b ?𝔊c"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
            )
        from assms(3) f Ran.HomCod.category_axioms have cf_hom_f𝔊c:
          "?cf_hom_f𝔊c :
            Hom 𝔄 b ?𝔊c ↦cat_Set α Hom 𝔄 a ?𝔊c"
          by 
            (
              cs_concl cs_intro:
                cat_cs_intros cat_prod_cs_intros cat_op_intros
            )
        from f assms(3) have dom_rhs: 
          "𝒟∘ (?cf_hom_f𝔊c⦇ArrVal⦈) = Hom 𝔄 b ?𝔊c"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
            )

        show ?thesis
        proof(rule arr_Set_eqI)
          from cf_eval_arrow_f_CId_𝔊c show "arr_Set α ?cf_eval_arrow"
            by (auto dest: cat_Set_is_arrD(1))
          from cf_hom_f𝔊c show "arr_Set α ?cf_hom_f𝔊c"
            by (auto dest: cat_Set_is_arrD(1))
          show "?cf_eval_arrow⦇ArrVal⦈ = ?cf_hom_f𝔊c⦇ArrVal⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
            from f assms(3) show "vsv (?cf_eval_arrow⦇ArrVal⦈)"
              by (cs_concl cs_intro: cat_cs_intros)
            from f assms(3) show "vsv (?cf_hom_f𝔊c⦇ArrVal⦈)"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_op_simps 
                    cs_intro: cat_cs_intros cat_op_intros
                )            
            fix g assume "g : b ↦𝔄 ?𝔊c"
            with f assms(3) show 
              "?cf_eval_arrow⦇ArrVal⦈⦇g⦈ = ?cf_hom_f𝔊c⦇ArrVal⦈⦇g⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_op_simps
                    cs_intro: cat_cs_intros cat_op_intros
                )
          qed simp

        qed
          (
            use cf_eval_arrow_f_CId_𝔊c cf_hom_f𝔊c in 
              ‹cs_concl cs_simp: cat_cs_simps›
          )+

      qed
      
      from f prems assms(3) show
        "E'⦇ArrMap⦈⦇f⦈ = HomO.Cβ𝔄(-,?𝔊c)⦇ArrMap⦈⦇f⦈"
        by
          (
            cs_concl
              cs_simp: cat_op_simps cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )

    qed (auto simp: E'_components cat_cs_intros assms(3))

  qed simp_all

  from Y' have inv_Y': "inv_ntcf Y' :
    HomO.Cβ𝔄(-,?𝔊c) ↦CF.iso N' : op_cat 𝔄 ↦↦Cβ cat_Set β"
    unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)

  interpret N'': is_functor β ‹op_cat 𝔄› ‹cat_Set β› ‹L_10_5_N α β 𝔗 𝔎 c›
    by (rule L_10_5_N_is_functor[OF β αβ assms])


  (** ψ **)

  define ψ :: V
    where "ψ =
      [
        (λa∈∘𝔄⦇Obj⦈. ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈),
        N',
        L_10_5_N α β 𝔗 𝔎 c,
        op_cat 𝔄,
        cat_Set β
      ]∘"

  have ψ_components:
    "ψ⦇NTMap⦈ = (λa∈∘𝔄⦇Obj⦈. ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈)"
    "ψ⦇NTDom⦈ = N'"
    "ψ⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c"
    "ψ⦇NTDGDom⦈ = op_cat 𝔄"
    "ψ⦇NTDGCod⦈ = cat_Set β"
    unfolding ψ_def nt_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = Y'_components(2-5)

  have ψ_NTMap_app[cat_cs_simps]: 
    "ψ⦇NTMap⦈⦇a⦈ = ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈" 
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding ψ_components by simp

  have ψ: "ψ : N' ↦CF.iso L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦Cβ cat_Set β"
  proof-

    show ?thesis
    proof(intro is_iso_ntcfI is_ntcfI')

      show "vfsequence ψ" unfolding ψ_def by auto
      show "vcard ψ = 5ℕ" unfolding ψ_def by (simp_all add: nat_omega_simps)
      show "N' : op_cat 𝔄 ↦↦Cβ cat_Set β" by (rule N')
      show "L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦Cβ cat_Set β"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "ψ⦇NTDom⦈ = N'" unfolding ψ_components by simp
      show "ψ⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c" unfolding ψ_components by simp
      show "ψ⦇NTDGDom⦈ = op_cat 𝔄" unfolding ψ_components by simp
      show "ψ⦇NTDGCod⦈ = cat_Set β" unfolding ψ_components by simp
      show "vsv (ψ⦇NTMap⦈)" unfolding ψ_components by simp
      show "𝒟∘ (ψ⦇NTMap⦈) = op_cat 𝔄⦇Obj⦈" 
        unfolding ψ_components by (simp add: cat_op_simps)

      show ψ_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
        "ψ⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦isocat_Set β L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
        if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      proof-
        note a = that[unfolded cat_op_simps]
        interpret ε: 
          is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 a› ε
          by (rule cat_pw_rKe_preserved[OF a])
        interpret aε: 
          is_cat_rKe α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 a› ‹?H_𝔄𝔊 a› ‹?H_𝔄ε a›
          by (rule ε.cat_rKe_preserves)
        interpret is_iso_ntcf
          β
          ‹op_cat (?FUNCT ℭ)›
          ‹cat_Set β›
          ‹?H_FUNCT ℭ (?H_𝔄𝔊 a)›
          ‹?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘CF op_cf ?SET_𝔎›
          ‹?ntcf_ua_fo a›
          by (rule aε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])
        have "cf_map (?H_ℭ c) ∈∘ ?FUNCT ℭ⦇Obj⦈"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
                cs_intro: cat_cs_intros cat_FUNCT_cs_intros
            )
        from 
          iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this] 
          a assms αβ 
        show ?thesis
          by (*very slow*)
            (
              cs_prems 
                cs_simp: 
                  cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps 
                cs_intro: 
                  cat_small_cs_intros 
                  cat_Kan_cs_intros
                  cat_cs_intros
                  cat_FUNCT_cs_intros
                  cat_op_intros
            )
      qed
      show ψ_NTMap_is_arr[unfolded cat_op_simps]: 
        "ψ⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦cat_Set β L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
        if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
        by 
          (
            rule cat_Set_is_arr_isomorphismD[
              OF ψ_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
              ]
          )

      show 
        "ψ⦇NTMap⦈⦇b⦈ ∘Acat_Set β N'⦇ArrMap⦈⦇f⦈ =
          L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈ ∘Acat_Set β ψ⦇NTMap⦈⦇a⦈"
        if "f : a ↦op_cat 𝔄 b" for a b f
      proof-

        note f = that[unfolded cat_op_simps]
        from f have a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔄⦇Obj⦈" by auto

        interpret p_a_ε: 
          is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 a› ε
          by (rule cat_pw_rKe_preserved[OF a])
        interpret a_ε: is_cat_rKe 
          α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 a› ‹?H_𝔄𝔊 a› ‹?H_𝔄ε a›
          by (rule p_a_ε.cat_rKe_preserves)
        interpret ntcf_ua_fo_a_ε: is_iso_ntcf
          β ?ua_NTDGDom ‹cat_Set β› ‹?ua_NTDom a› ‹?ua_NTCod a› ‹?ua a›
          by (rule a_ε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])

        interpret p_b_ε:
          is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 b› ε
          by (rule cat_pw_rKe_preserved[OF b])
        interpret b_ε: is_cat_rKe 
          α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 b› ‹?H_𝔄𝔊 b› ‹?H_𝔄ε b›
          by (rule p_b_ε.cat_rKe_preserves)
        interpret ntcf_ua_fo_b_ε: is_iso_ntcf
          β ?ua_NTDGDom ‹cat_Set β› ‹?ua_NTDom b› ‹?ua_NTCod b› ‹?ua b›
          by (rule b_ε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])

        interpret 𝔎_SET: is_tiny_functor β ‹?FUNCT ℭ› ‹?FUNCT 𝔅› ?SET_𝔎
          by 
            (
              rule exp_cat_cf_is_tiny_functor[
                OF β αβ AG.category_cat_Set AG.is_functor_axioms
                ]
            )
        from f interpret Hom_f:
          is_ntcf α 𝔄 ‹cat_Set α› ‹?H_𝔄 a› ‹?H_𝔄 b› ‹?H_A f›
          by (cs_concl cs_intro: cat_cs_intros)

        let ?cf_hom_lhs =
          ‹
            cf_hom
              (?FUNCT ℭ)
              [ntcf_arrow (ntcf_id (?H_ℭ c)), ntcf_arrow (?H_A𝔊 f)]∘
          ›
        let ?cf_hom_rhs = 
          ‹
            cf_hom
              (?FUNCT 𝔅)
              [
                ntcf_arrow (ntcf_id (?H_ℭ c ∘CF 𝔎)),
                ntcf_arrow (?H_A f ∘NTCF-CF 𝔗)
              ]∘
          ›
        let ?dom =
          ‹Hom (?FUNCT ℭ) (cf_map (?H_ℭ c)) (cf_map (?H_𝔄𝔊 a))›
        let ?cod = ‹Hom (?FUNCT 𝔅) (cf_map (?H_ℭ𝔎 c)) (cf_map (?H_𝔄𝔗 b))›
        let ?cf_hom_lhs_umap_fo_inter =
          ‹Hom (?FUNCT ℭ) (cf_map (?H_ℭ c)) (cf_map (?H_𝔄𝔊 b))›
        let ?umap_fo_cf_hom_rhs_inter =
          ‹Hom (?FUNCT 𝔅) (cf_map (?H_ℭ𝔎 c)) (cf_map (?H_𝔄𝔗 a))›

        have [cat_cs_simps]:
          "?umap_fo b ∘Acat_Set β ?cf_hom_lhs =
            ?cf_hom_rhs ∘Acat_Set β ?umap_fo a"
        proof-

          from f assms(3) αβ have cf_hom_lhs:
            "?cf_hom_lhs : ?dom ↦cat_Set β ?cf_hom_lhs_umap_fo_inter"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from f assms(3) αβ have umap_fo_b:
            "?umap_fo b : ?cf_hom_lhs_umap_fo_inter ↦cat_Set β ?cod"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro: 
                    cat_small_cs_intros
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
            "?umap_fo b ∘Acat_Set β ?cf_hom_lhs : ?dom ↦cat_Set β ?cod"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          then have dom_umap_fo_cf_hom_lhs: 
            "𝒟∘ ((?umap_fo b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈) = ?dom"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

          from f assms(3) αβ have cf_hom_rhs: 
            "?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter ↦cat_Set β ?cod"
            by (*slow*)
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from f assms(3) αβ have umap_fo_a:
            "?umap_fo a : ?dom ↦cat_Set β ?umap_fo_cf_hom_rhs_inter"
            by (*slow*)
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_small_cs_intros 
                    cat_cs_intros 
                    cat_FUNCT_cs_intros 
                    cat_prod_cs_intros 
                    cat_op_intros
              )
          from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a: 
            "?cf_hom_rhs ∘Acat_Set β ?umap_fo a : ?dom ↦cat_Set β ?cod"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
          then have dom_cf_hom_rhs_umap_fo_a: 
            "𝒟∘ ((?cf_hom_rhs ∘Acat_Set β ?umap_fo a)⦇ArrVal⦈) = ?dom"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          
          show ?thesis
          proof(rule arr_Set_eqI)

            from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs: 
              "arr_Set β (?umap_fo b ∘Acat_Set β ?cf_hom_lhs)"
              by (auto dest: cat_Set_is_arrD(1))
            from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a: 
              "arr_Set β (?cf_hom_rhs ∘Acat_Set β ?umap_fo a)"
              by (auto dest: cat_Set_is_arrD(1))

            show 
              "(?umap_fo b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈ =
                (?cf_hom_rhs ∘Acat_Set β ?umap_fo a)⦇ArrVal⦈"
            proof
              (
                rule vsv_eqI, 
                unfold 
                  dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff; 
                (rule refl)?
              )

              fix ℌ assume prems:
                "ℌ : cf_map (?H_ℭ c) ↦?FUNCT ℭ cf_map (?H_𝔄𝔊 a)"

              let ?ℌ = ‹ntcf_of_ntcf_arrow ℭ (cat_Set α) ℌ›
              let ?lhs = ‹?H_𝔄ε b ∙NTCF ((?H_A𝔊 f ∙NTCF ?ℌ) ∘NTCF-CF 𝔎)›
              let ?rhs = 
                ‹(?H_A f ∘NTCF-CF 𝔗 ∙NTCF ?H_𝔄ε a ∙NTCF (?ℌ ∘NTCF-CF 𝔎))›
              let ?cf_hom_𝔄ε = ‹λb b'. cf_hom 𝔄 [𝔄⦇CId⦈⦇b⦈, ε⦇NTMap⦈⦇b'⦈]∘›
              let ?Yc = ‹λQ. Yoneda_component (?H_𝔄 b) a f Q›
              let ?ℌ𝔎 = ‹λb'. ?ℌ⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
              let ?𝔊𝔎 = ‹λb'. 𝔊⦇ObjMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›

              have [cat_cs_simps]: 
                "cf_of_cf_map ℭ (cat_Set α) (cf_map (?H_ℭ c)) = ?H_ℭ c"
                by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
              have [cat_cs_simps]: 
                "cf_of_cf_map ℭ (cat_Set α) (cf_map (?H_𝔄𝔊 a)) = ?H_𝔄𝔊 a"
                by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
              note ℌ = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
              have Hom_c: "?H_ℭ𝔎 c : 𝔅 ↦↦Cα cat_Set α"
                by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

              have [cat_cs_simps]: "?lhs = ?rhs"
              proof(rule ntcf_eqI)
                from ℌ(1) f show lhs: 
                  "?lhs : ?H_ℭ𝔎 c ↦CF ?H_𝔄𝔗 b : 𝔅 ↦↦Cα cat_Set α"
                  by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                then have dom_lhs: "𝒟∘ (?lhs⦇NTMap⦈) = 𝔅⦇Obj⦈" 
                  by (cs_concl cs_simp: cat_cs_simps)+
                from ℌ(1) f show rhs: 
                  "?rhs : ?H_ℭ𝔎 c ↦CF ?H_𝔄𝔗 b : 𝔅 ↦↦Cα cat_Set α"
                  by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                then have dom_rhs: "𝒟∘ (?rhs⦇NTMap⦈) = 𝔅⦇Obj⦈"
                  by (cs_concl cs_simp: cat_cs_simps)+
                have [cat_cs_simps]:
                  "?cf_hom_𝔄ε b b' ∘Acat_Set α 
                    (?Yc (?𝔊𝔎 b') ∘Acat_Set α ?ℌ𝔎 b') =
                      ?Yc (𝔗⦇ObjMap⦈⦇b'⦈) ∘Acat_Set α
                        (?cf_hom_𝔄ε a b' ∘Acat_Set α ?ℌ𝔎 b')"
                  (is ‹?lhs_Set = ?rhs_Set›)
                  if "b' ∈∘ 𝔅⦇Obj⦈" for b'
                proof-
                  let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
                  from ℌ(1) f that assms(3) Ran.HomCod.category_axioms 
                  have lhs_Set_is_arr: "?lhs_Set :
                    Hom ℭ c (?𝔎b') ↦cat_Set α Hom 𝔄 b (𝔗⦇ObjMap⦈⦇b'⦈)"
                    by
                      (
                        cs_concl
                          cs_simp: cat_cs_simps cat_op_simps 
                          cs_intro: 
                            cat_cs_intros cat_prod_cs_intros cat_op_intros
                      )
                  then have dom_lhs_Set: "𝒟∘ (?lhs_Set⦇ArrVal⦈) = Hom ℭ c ?𝔎b'" 
                    by (cs_concl cs_simp: cat_cs_simps)
                  from ℌ(1) f that assms(3) Ran.HomCod.category_axioms 
                  have rhs_Set_is_arr: "?rhs_Set :
                    Hom ℭ c (?𝔎b') ↦cat_Set α Hom 𝔄 b (𝔗⦇ObjMap⦈⦇b'⦈)"
                    by
                      (
                        cs_concl
                          cs_simp: cat_cs_simps cat_op_simps 
                          cs_intro:
                            cat_cs_intros cat_prod_cs_intros cat_op_intros
                      )
                  then have dom_rhs_Set: "𝒟∘ (?rhs_Set⦇ArrVal⦈) = Hom ℭ c ?𝔎b'" 
                    by (cs_concl cs_simp: cat_cs_simps)
                show ?thesis
                proof(rule arr_Set_eqI)
                  from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set α ?lhs_Set" 
                    by (auto dest: cat_Set_is_arrD(1))
                  from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set α ?rhs_Set"
                    by (auto dest: cat_Set_is_arrD(1))
                  show "?lhs_Set⦇ArrVal⦈ = ?rhs_Set⦇ArrVal⦈"
                  proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
                    fix h assume "h : c ↦ℭ ?𝔎b'"
                    with ℌ(1) f that assms Ran.HomCod.category_axioms show 
                      "?lhs_Set⦇ArrVal⦈⦇h⦈ = ?rhs_Set⦇ArrVal⦈⦇h⦈"
                      by (*exceptionally slow*) 
                        (
                          cs_concl 
                            cs_simp: cat_cs_simps cat_op_simps 
                            cs_intro: 
                              cat_cs_intros cat_prod_cs_intros cat_op_intros
                        )
                  qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
                qed
                  (
                    use lhs_Set_is_arr rhs_Set_is_arr in
                      ‹cs_concl cs_simp: cat_cs_simps›
                  )+

              qed

              show "?lhs⦇NTMap⦈ = ?rhs⦇NTMap⦈"
              proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
                fix b' assume "b' ∈∘ 𝔅⦇Obj⦈"
                with ℌ(1) f assms(3) show "?lhs⦇NTMap⦈⦇b'⦈ = ?rhs⦇NTMap⦈⦇b'⦈"
                  by (*slow*)
                    (
                      cs_concl
                        cs_simp: cat_cs_simps cat_op_simps 
                        cs_intro: cat_cs_intros
                    )
              qed (cs_concl cs_intro: cat_cs_intros)

            qed simp_all

            from 
              assms(3) f ℌ(1) prems αβ 
              (*speedup*)
              Ran.HomCod.category_axioms 
              FUNCT_ℭ.category_axioms
              FUNCT_𝔅.category_axioms
              AG.is_functor_axioms
              Ran.is_functor_axioms
              Hom_f.is_ntcf_axioms
            show
              "(?umap_fo b ∘Acat_Set β ?cf_hom_lhs)⦇ArrVal⦈⦇ℌ⦈ =
                (?cf_hom_rhs ∘Acat_Set β ?umap_fo a)⦇ArrVal⦈⦇ℌ⦈"
                by (subst (1 2) ℌ(2)) (*exceptionally slow*)
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
                    cs_intro:
                      cat_cs_intros 
                      cat_prod_cs_intros 
                      cat_FUNCT_cs_intros
                      cat_op_intros
                )

            qed
              (
                use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
                  auto
              )

          qed
            (
              use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
                ‹cs_concl cs_simp: cat_cs_simps›
            )+

        qed

        from f assms αβ show ?thesis
          by (*slow*)
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
                cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )

      qed

    qed auto

  qed


  (**main**)

  from L_10_5_χ_is_iso_ntcf[OF β αβ assms] have inv_χ:
    "inv_ntcf (L_10_5_χ α β 𝔗 𝔎 c) :
      L_10_5_N α β 𝔗 𝔎 c ↦CF.iso cf_Cone α β ?𝔗_c𝔎 :
      op_cat 𝔄 ↦↦Cβ cat_Set β"
    by (auto intro: iso_ntcf_is_arr_isomorphism)
 
  define φ where "φ = inv_ntcf (L_10_5_χ α β 𝔗 𝔎 c) ∙NTCF ψ ∙NTCF inv_ntcf Y'"
  
  from inv_Y' ψ inv_χ have φ: "φ :
    HomO.Cβ𝔄(-,?𝔊c) ↦CF.iso cf_Cone α β ?𝔗_c𝔎 :
    op_cat 𝔄 ↦↦Cβ cat_Set β"
    unfolding φ_def by (cs_concl cs_intro: cat_cs_intros)

  interpret φ: is_iso_ntcf
    β ‹op_cat 𝔄› ‹cat_Set β› ‹HomO.Cβ𝔄(-,?𝔊c)› ‹cf_Cone α β ?𝔗_c𝔎› φ
    by (rule φ)

  let ?φ_𝔊c_CId = ‹φ⦇NTMap⦈⦇?𝔊c⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇?𝔊c⦈⦈›
  let ?ntcf_φ_𝔊c_CId = ‹ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 ?φ_𝔊c_CId›

  from AG.vempty_is_zet assms(3) have Δ: "?Δ : 𝔄 ↦↦Cα ?c𝔎_𝔄"
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  from assms(3) have 𝔊c: "?𝔊c ∈∘ 𝔄⦇Obj⦈" 
    by (cs_concl cs_intro: cat_cs_intros)
  from AG.vempty_is_zet have 𝔗_c𝔎: "cf_map (?𝔗_c𝔎) ∈∘ ?c𝔎_𝔄⦇Obj⦈"
    by
      (
        cs_concl
          cs_simp: cat_Funct_components(1) 
          cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
      )

  from
    φ.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF 𝔊c]
    assms(3)
    AG.vempty_is_zet
    β.vempty_is_zet
    αβ
  have φ_𝔊c: "φ⦇NTMap⦈⦇?𝔊c⦈ :
    Hom 𝔄 ?𝔊c?𝔊c ↦cat_Set β 
    Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 ?𝔊c)) (cf_map ?𝔗_c𝔎)"
    by (*very slow*)
      (
        cs_prems
          cs_simp:
            cat_cs_simps
            cat_Kan_cs_simps
            cat_comma_cs_simps 
            cat_op_simps 
            cat_Funct_components(1) 
          cs_intro: 
            cat_small_cs_intros
            cat_Kan_cs_intros
            cat_comma_cs_intros 
            cat_cs_intros 
            cat_FUNCT_cs_intros 
            cat_op_intros 
            category.cat_category_if_ge_Limit[where α=α and β=β]
            is_functor.cf_is_functor_if_ge_Limit[where α=α and β=β]
      )

  with assms(3) have φ_𝔊c_CId: 
    "?φ_𝔊c_CId : cf_map (?cf_c𝔎_𝔄 ?𝔊c) ↦?c𝔎_𝔄 cf_map ?𝔗_c𝔎"
    by (cs_concl cs_intro: cat_cs_intros)
  have ntcf_arrow_φ_𝔊c_CId: "ntcf_arrow ?ntcf_φ_𝔊c_CId = ?φ_𝔊c_CId"
    by (rule cat_Funct_is_arrD(2)[OF φ_𝔊c_CId, symmetric])
  have ua: "universal_arrow_fo ?Δ (cf_map (?𝔗_c𝔎)) ?𝔊c ?φ_𝔊c_CId"
    by 
      (
        rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit[
          OF Δ β αβ 𝔊c 𝔗_c𝔎 φ[unfolded cf_Cone_def cat_cs_simps]
          ]
      )
  moreover have ntcf_φ_𝔊c_CId: 
    "?ntcf_φ_𝔊c_CId : ?𝔊c <CF.cone ?𝔗_c𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
  proof(intro is_cat_coneI)
    from cat_Funct_is_arrD(1)[OF φ_𝔊c_CId] assms(3) AG.vempty_is_zet show 
      "ntcf_of_ntcf_arrow (c ↓CF 𝔎) 𝔄 ?φ_𝔊c_CId :
        ?cf_c𝔎_𝔄 ?𝔊c ↦CF.tm ?𝔗_c𝔎 : c ↓CF 𝔎 ↦↦C.tmα 𝔄"
      by
        (
          cs_prems
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (rule 𝔊c)
  ultimately have "?ntcf_φ_𝔊c_CId : ?𝔊c <CF.lim ?𝔗_c𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    by 
      (
        intro is_cat_limitI[
          where u=‹?ntcf_φ_𝔊c_CId›, unfolded ntcf_arrow_φ_𝔊c_CId
          ]
      )
  then show ?thesis using that by auto

qed



subsection‹The limit for the pointwise Kan extension›


subsubsection‹Definition and elementary properties›


text‹See Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.›

definition the_pw_cat_rKe_limit :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c =
    [
      𝔊⦇ObjMap⦈⦇c⦈,
      (
        SOME UA.
          UA : 𝔊⦇ObjMap⦈⦇c⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔗⦇HomCod⦈
      )
    ]∘"


text‹Components.›

lemma the_pw_cat_rKe_limit_components:
  shows "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UObj⦈ = 𝔊⦇ObjMap⦈⦇c⦈"
    and "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UArr⦈ = 
      (
        SOME UA.
          UA : 𝔊⦇ObjMap⦈⦇c⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔗⦇HomCod⦈
      )"
  unfolding the_pw_cat_rKe_limit_def ua_field_simps
  by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas the_pw_cat_rKe_limit_components' = 
  the_pw_cat_rKe_limit_components[where 𝔗=𝔉, unfolded cat_cs_simps]

end


subsubsection‹The limit for the pointwise Kan extension is a limit›

lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_limit:
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UArr⦈ :
    the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UObj⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 :
    c ↓CF 𝔎 ↦↦Cα 𝔄"
proof-
  from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA 
    where UA: "UA : 𝔊⦇ObjMap⦈⦇c⦈ <CF.lim 𝔗 ∘CF c O⨅CF 𝔎 : c ↓CF 𝔎 ↦↦Cα 𝔄"
    by auto
  show ?thesis
    unfolding the_pw_cat_rKe_limit_components
    by (rule someI2, unfold cat_cs_simps, rule UA)
qed

lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe: 
  assumes "𝔎 : 𝔅 ↦↦C.tmα ℭ"
    and "𝔗 : 𝔅 ↦↦C.tmα 𝔄"
  shows "the_ntcf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) :
    the_cf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) ∘CF 𝔎 ↦CF.rKeα 𝔗 :
    𝔅 ↦C ℭ ↦C 𝔄"
proof-
  interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
  show "the_ntcf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) :
    the_cf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) ∘CF 𝔎 ↦CF.rKeα 𝔗 :
    𝔅 ↦C ℭ ↦C 𝔄"
    by
      (
        rule
          the_ntcf_rKe_is_cat_rKe
            [
              OF
                assms(1)
                ntcf_rKe.NTCod.is_functor_axioms 
                cat_pw_rKe_the_pw_cat_rKe_limit_is_limit[OF assms]
            ]
      )
qed

text‹\newpage›

end

Theory CZH_UCAT_PWKan_Example

(* Copyright 2021 (C) Mihails Milehins *)

section‹Pointwise Kan extensions: application example›
theory CZH_UCAT_PWKan_Example
  imports
    CZH_Elementary_Categories.CZH_ECAT_Ordinal
    CZH_UCAT_PWKan
begin



subsection‹Background›


text‹
The application example presented in this section is based on 
Exercise 6.1.ii in \cite{riehl_category_2016}.
›

(*TODO: is the explicit elimination rule necessary?*)
lemma cat_ordinal_2_is_arrE:
  assumes "f : a ↦cat_ordinal (2ℕ) b"
  obtains "f = [0, 0]∘" and " a = 0" and "b = 0" 
    | "f = [0, 1ℕ]∘" and "a = 0" and "b = 1ℕ"
    | "f = [1ℕ, 1ℕ]∘" and "a = 1ℕ" and "b = 1ℕ"
  using cat_ordinal_is_arrD[OF assms] unfolding two by auto

(*TODO: is the explicit elimination rule necessary?*)
lemma cat_ordinal_3_is_arrE:
  assumes "f : a ↦cat_ordinal (3ℕ) b"
  obtains "f = [0, 0]∘" and " a = 0" and "b = 0" 
    | "f = [0, 1ℕ]∘" and "a = 0" and "b = 1ℕ"
    | "f = [0, 2ℕ]∘" and "a = 0" and "b = 2ℕ"
    | "f = [1ℕ, 1ℕ]∘" and "a = 1ℕ" and "b = 1ℕ"
    | "f = [1ℕ, 2ℕ]∘" and "a = 1ℕ" and "b = 2ℕ"
    | "f = [2ℕ, 2ℕ]∘" and "a = 2ℕ" and "b = 2ℕ"
  using cat_ordinal_is_arrD[OF assms] unfolding three by auto

lemma 0123: "0 ∈∘ 2ℕ" "1ℕ ∈∘ 2ℕ" "0 ∈∘ 3ℕ" "1ℕ ∈∘ 3ℕ" "2ℕ ∈∘ 3ℕ" by auto



subsection‹‹𝔎23››


subsubsection‹Definition and elementary properties›

definition 𝔎23 :: V
  where "𝔎23 =
    [
      (λa∈∘cat_ordinal (2ℕ)⦇Obj⦈. if a = 0 then 0 else 2ℕ), 
      (
        λf∈∘cat_ordinal (2ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ [0, 0]∘
          | f = [0, 1ℕ]∘ ⇒ [0, 2ℕ]∘
          | f = [1ℕ, 1ℕ]∘ ⇒ [2ℕ, 2ℕ]∘
          | otherwise ⇒ 0
      ), 
      cat_ordinal (2ℕ),
      cat_ordinal (3ℕ)
    ]∘"


text‹Components.›

lemma 𝔎23_components:
  shows "𝔎23⦇ObjMap⦈ = (λa∈∘cat_ordinal (2ℕ)⦇Obj⦈. if a = 0 then 0 else 2ℕ)"
    and "𝔎23⦇ArrMap⦈ =
      (
        λf∈∘cat_ordinal (2ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ [0, 0]∘
          | f = [0, 1ℕ]∘ ⇒ [0, 2ℕ]∘
          | f = [1ℕ, 1ℕ]∘ ⇒ [2ℕ, 2ℕ]∘
          | otherwise ⇒ 0
      )"
    and [cat_Kan_cs_simps]: "𝔎23⦇HomDom⦈ = cat_ordinal (2ℕ)"
    and [cat_Kan_cs_simps]: "𝔎23⦇HomCod⦈ = cat_ordinal (3ℕ)"
  unfolding 𝔎23_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Object map›

mk_VLambda 𝔎23_components(1)
  |vsv 𝔎23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain 𝔎23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app 𝔎23_ObjMap_app|

lemma 𝔎23_ObjMap_app_0[cat_Kan_cs_simps]: 
  assumes "x = 0"
  shows "𝔎23⦇ObjMap⦈⦇x⦈ = 0"
  by 
    (
      cs_concl 
        cs_simp: 𝔎23_ObjMap_app cat_ordinal_cs_simps V_cs_simps assms 
        cs_intro: nat_omega_intros
    )

lemma 𝔎23_ObjMap_app_1[cat_Kan_cs_simps]: 
  assumes "x = 1ℕ"
  shows "𝔎23⦇ObjMap⦈⦇x⦈ = 2ℕ"
  by 
    (
      cs_concl 
        cs_simp: 
          cat_ordinal_cs_simps V_cs_simps omega_of_set 𝔎23_ObjMap_app assms
        cs_intro: nat_omega_intros V_cs_intros
    )


subsubsection‹Arrow map›

mk_VLambda 𝔎23_components(2)
  |vsv 𝔎23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain 𝔎23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app 𝔎23_ArrMap_app|

lemma 𝔎23_ArrMap_app_00[cat_Kan_cs_simps]: 
  assumes "f = [0, 0]∘"
  shows "𝔎23⦇ArrMap⦈⦇f⦈ = [0, 0]∘"
  unfolding assms
  by 
    (
      cs_concl 
        cs_simp: 𝔎23_ArrMap_app cat_ordinal_cs_simps V_cs_simps 
        cs_intro: cat_ordinal_cs_intros nat_omega_intros
    )

lemma 𝔎23_ArrMap_app_01[cat_Kan_cs_simps]: 
  assumes "f = [0, 1ℕ]∘"
  shows "𝔎23⦇ArrMap⦈⦇f⦈ = [0, 2ℕ]∘"
proof-
  have "[0, 1ℕ]∘ ∈∘ ordinal_arrs (2ℕ)"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set 
          cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
      )
  then show ?thesis
    unfolding assms by (simp add: 𝔎23_components cat_ordinal_components)
qed

lemma 𝔎23_ArrMap_app_11[cat_Kan_cs_simps]: 
  assumes "f = [1ℕ, 1ℕ]∘"
  shows "𝔎23⦇ArrMap⦈⦇f⦈ = [2ℕ, 2ℕ]∘"
proof-
  have "[1ℕ, 1ℕ]∘ ∈∘ ordinal_arrs (2ℕ)"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set 
          cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
      )
  then show ?thesis
    unfolding assms by (simp add: 𝔎23_components cat_ordinal_components)
qed


subsubsection‹‹𝔎23› is a tiny functor›

lemma (in 𝒵) 𝔎23_is_functor: "𝔎23 : cat_ordinal (2ℕ) ↦↦Cα cat_ordinal (3ℕ)"
proof-

  from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  show ?thesis
  proof(intro is_tiny_functorI' is_functorI')

    show "vfsequence 𝔎23" unfolding 𝔎23_def by auto
    show "vcard 𝔎23 = 4ℕ" unfolding 𝔎23_def by (simp add: nat_omega_simps)

    show "ℛ∘ (𝔎23⦇ObjMap⦈) ⊆∘ cat_ordinal (3ℕ)⦇Obj⦈"
    proof
      (
        rule vsv.vsv_vrange_vsubset, 
        unfold cat_Kan_cs_simps cat_ordinal_cs_simps, 
        intro cat_Kan_cs_intros
      )
      fix x assume "x ∈∘ 2ℕ"
      then consider ‹x = 0› | ‹x = 1ℕ› unfolding two by auto
      then show "𝔎23⦇ObjMap⦈⦇x⦈ ∈∘ 3ℕ"
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps omega_of_set cs_intro: nat_omega_intros
          )+
    qed

    show "𝔎23⦇ArrMap⦈⦇f⦈ : 𝔎23⦇ObjMap⦈⦇a⦈ ↦cat_ordinal (3ℕ) 𝔎23⦇ObjMap⦈⦇b⦈"
      if "f : a ↦cat_ordinal (2ℕ) b" for a b f
      using that 
      by (elim cat_ordinal_2_is_arrE; simp only:) 
        (
          cs_concl
            cs_simp: omega_of_set cat_Kan_cs_simps
            cs_intro: nat_omega_intros V_cs_intros cat_ordinal_cs_intros
        )

    show 
      "𝔎23⦇ArrMap⦈⦇g ∘Acat_ordinal (2ℕ) f⦈ =
        𝔎23⦇ArrMap⦈⦇g⦈ ∘Acat_ordinal (3ℕ) 𝔎23⦇ArrMap⦈⦇f⦈"
      if "g : b ↦cat_ordinal (2ℕ) c" and "f : a ↦cat_ordinal (2ℕ) b"
      for b c g a f 
    proof-
      have "0 ∈∘ 3ℕ" "1ℕ ∈∘ 3ℕ" "2ℕ ∈∘ 3ℕ" by auto
      then show ?thesis
        using that
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl 
              cs_simp: cat_ordinal_cs_simps cat_Kan_cs_simps  
              cs_intro: V_cs_intros cat_ordinal_cs_intros
          )+    
    qed

    show 
      "𝔎23⦇ArrMap⦈⦇cat_ordinal (2ℕ)⦇CId⦈⦇c⦈⦈ =
        cat_ordinal (3ℕ)⦇CId⦈⦇𝔎23⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ cat_ordinal (2ℕ)⦇Obj⦈" for c
    proof-
      from that consider ‹c = 0› | ‹c = 1ℕ›
        unfolding cat_ordinal_components(1) two by auto
      then show ?thesis
        by (cases, use nothing in ‹simp_all only:›) 
          (
            cs_concl
              cs_simp: omega_of_set cat_Kan_cs_simps cat_ordinal_cs_simps  
              cs_intro: nat_omega_intros cat_ordinal_cs_intros
          )
    qed

  qed (auto intro!: cat_cs_intros simp: 𝔎23_components)

qed

lemma (in 𝒵) 𝔎23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔄' = cat_ordinal (2ℕ)"
    and "𝔅' = cat_ordinal (3ℕ)"
  shows "𝔎23 : 𝔄' ↦↦Cα 𝔅'"
  unfolding assms by (rule 𝔎23_is_functor)

lemmas [cat_Kan_cs_intros] = 𝒵.𝔎23_is_functor'

lemma (in 𝒵) 𝔎23_is_tiny_functor: 
  "𝔎23 : cat_ordinal (2ℕ) ↦↦C.tinyα cat_ordinal (3ℕ)"
proof-
  from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  show ?thesis
    by (intro is_tiny_functorI' 𝔎23_is_functor)
      (auto intro!: cat_small_cs_intros)
qed

lemma (in 𝒵) 𝔎23_is_tiny_functor'[cat_Kan_cs_intros]:
  assumes "𝔄' = cat_ordinal (2ℕ)"
    and "𝔅' = cat_ordinal (3ℕ)"
  shows "𝔎23 : 𝔄' ↦↦C.tinyα 𝔅'"
  unfolding assms by (rule 𝔎23_is_tiny_functor)

lemmas [cat_Kan_cs_intros] = 𝒵.𝔎23_is_tiny_functor'



subsection‹
‹LK23›: the functor associated with the left Kan extension along const‹𝔎23›
›


subsubsection‹Definition and elementary properties›

definition LK23 :: "V ⇒ V"
  where "LK23 𝔉 =
    [
      (
        λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
         if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
          | a = 1ℕ ⇒ 𝔉⦇ObjMap⦈⦇0⦈
          | a = 2ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
      ), 
      (
        λf∈∘cat_ordinal (3ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [1ℕ, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [1ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [2ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
      ), 
      cat_ordinal (3ℕ),
      𝔉⦇HomCod⦈
    ]∘"


text‹Components.›

lemma LK23_components:
  shows "LK23 𝔉⦇ObjMap⦈ =
    (
      λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
        if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
         | a = 1ℕ ⇒ 𝔉⦇ObjMap⦈⦇0⦈
         | a = 2ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
         | otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
    )"
    and "LK23 𝔉⦇ArrMap⦈ =
      (
        λf∈∘cat_ordinal (3ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [1ℕ, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [1ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [2ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
      )"
    and "LK23 𝔉⦇HomDom⦈ = cat_ordinal (3ℕ)"
    and "LK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
  unfolding LK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas LK23_components' = LK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = LK23_components'(3,4)

end

lemmas [cat_Kan_cs_simps] = is_functor.LK23_components'(3,4)


subsubsection‹Object map›

mk_VLambda LK23_components(1)
  |vsv LK23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app LK23_ObjMap_app|

lemma LK23_ObjMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
  unfolding LK23_components assms cat_ordinal_components by simp

lemma LK23_ObjMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1ℕ"
  shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
  unfolding LK23_components assms cat_ordinal_components by simp

lemma LK23_ObjMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2ℕ"
  shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1ℕ⦈"
  unfolding LK23_components assms cat_ordinal_components by simp


subsubsection‹Arrow map›

mk_VLambda LK23_components(2)
  |vsv LK23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app LK23_ArrMap_app|

lemma LK23_ArrMap_app_00[cat_Kan_cs_simps]:
  assumes "f = [0, 0]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_01[cat_Kan_cs_simps]:
  assumes "f = [0, 1ℕ]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_02[cat_Kan_cs_simps]:
  assumes "f = [0, 2ℕ]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_11[cat_Kan_cs_simps]:
  assumes "f = [1ℕ, 1ℕ]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_12[cat_Kan_cs_simps]:
  assumes "f = [1ℕ, 2ℕ]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set   
          cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_22[cat_Kan_cs_simps]:
  assumes "f = [2ℕ, 2ℕ]∘"
  shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro: 
          nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by simp
qed


subsubsection‹‹LK23› is a functor›

lemma cat_LK23_is_functor:
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
  shows "LK23 𝔉 : cat_ordinal (3ℕ) ↦↦Cα ℭ"
proof-

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms(1))

  from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms)

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (LK23 𝔉)" unfolding LK23_def by auto
    show "vcard (LK23 𝔉) = 4ℕ" unfolding LK23_def by (simp add: nat_omega_simps)
    show "ℛ∘ (LK23 𝔉⦇ObjMap⦈) ⊆∘ ℭ⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
      fix x assume prems: "x ∈∘ cat_ordinal (3ℕ)⦇Obj⦈"
      then consider ‹x = 0› | ‹x = 1ℕ› | ‹x = 2ℕ›
        unfolding cat_ordinal_cs_simps three by auto
      then show "LK23 𝔉⦇ObjMap⦈⦇x⦈ ∈∘ ℭ⦇Obj⦈" 
        by cases
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set 
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_intro: cat_Kan_cs_intros)
    show "LK23 𝔉⦇ArrMap⦈⦇f⦈ : LK23 𝔉⦇ObjMap⦈⦇a⦈ ↦ℭ LK23 𝔉⦇ObjMap⦈⦇b⦈"
      if "f : a ↦cat_ordinal (3ℕ) b" for a b f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_Kan_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show 
      "LK23 𝔉⦇ArrMap⦈⦇g ∘Acat_ordinal (3ℕ) f⦈ =
        LK23 𝔉⦇ArrMap⦈⦇g⦈ ∘Aℭ LK23 𝔉⦇ArrMap⦈⦇f⦈"
      if "g : b ↦cat_ordinal (3ℕ) c" and "f : a ↦cat_ordinal (3ℕ) b"
      for b c g a f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:; (solves‹simp›)?) (*slow*)
          (
            cs_concl 
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                𝔉.cf_ArrMap_Comp[symmetric]
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show "LK23 𝔉⦇ArrMap⦈⦇cat_ordinal (3ℕ)⦇CId⦈⦇c⦈⦈ = ℭ⦇CId⦈⦇LK23 𝔉⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ cat_ordinal (3ℕ)⦇Obj⦈" for c
    proof-
      from that consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ›
        unfolding cat_ordinal_components three by auto
      moreover have "0 ∈∘ 2ℕ" "1ℕ ∈∘ 2ℕ" "0 ∈∘ 3ℕ" "1ℕ ∈∘ 3ℕ" "2ℕ ∈∘ 3ℕ" by auto
      ultimately show ?thesis
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl 
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                is_functor.cf_ObjMap_CId[symmetric]  
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma cat_LK23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
    and "𝔄' = cat_ordinal (3ℕ)"
  shows "LK23 𝔉 : 𝔄' ↦↦Cα ℭ"
  using assms(1) unfolding assms(2) by (rule cat_LK23_is_functor)


subsubsection‹The fundamental property of ‹LK23››

lemma cf_comp_LK23_𝔎23[cat_Kan_cs_simps]: 
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
  shows "LK23 𝔉 ∘CF 𝔎23 = 𝔉"
proof-

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms(1))
  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor α ‹cat_ordinal (3ℕ)› ℭ ‹LK23 𝔉›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI)
    show "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ" by (rule assms)
    have ObjMap_dom_lhs: "𝒟∘ ((LK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈) = 2ℕ"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
        )
    have ObjMap_dom_rhs: "𝒟∘ (𝔉⦇ObjMap⦈) = 2ℕ"
      by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
    show "(LK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume prems: "a ∈∘ 2ℕ"
      then consider ‹a = 0› | ‹a = 1ℕ› by force
      then show "(LK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇a⦈"
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl
              cs_simp:
                omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
    have ArrMap_dom_lhs: "𝒟∘ ((LK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈) = cat_ordinal (2ℕ)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have ArrMap_dom_rhs: "𝒟∘ (𝔉⦇ArrMap⦈) = cat_ordinal (2ℕ)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(LK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume prems: "f ∈∘ cat_ordinal (2ℕ)⦇Arr⦈"
      then obtain a b where "f : a ↦cat_ordinal (2ℕ) b" by auto
      then show "(LK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇f⦈"
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
  qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

qed



subsection‹
‹RK23›: the functor associated with the right Kan extension along const‹𝔎23›
›


subsubsection‹Definition and elementary properties›

definition RK23 :: "V ⇒ V"
  where "RK23 𝔉 =
    [
      (
        λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
         if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
          | a = 1ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
          | a = 2ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
      ),
      (
        λf∈∘cat_ordinal (3ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [0, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [1ℕ, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | f = [1ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | f = [2ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
      ), 
      cat_ordinal (3ℕ),
      𝔉⦇HomCod⦈
    ]∘"


text‹Components.›

lemma RK23_components:
  shows "RK23 𝔉⦇ObjMap⦈ =
    (
      λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
        if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
         | a = 1ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
         | a = 2ℕ ⇒ 𝔉⦇ObjMap⦈⦇1ℕ⦈
         | otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
    )"
    and "RK23 𝔉⦇ArrMap⦈ =
      (
        λf∈∘cat_ordinal (3ℕ)⦇Arr⦈.
         if f = [0, 0]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈∙
          | f = [0, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [0, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙
          | f = [1ℕ, 1ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | f = [1ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | f = [2ℕ, 2ℕ]∘ ⇒ 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙
          | otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
      )"
    and "RK23 𝔉⦇HomDom⦈ = cat_ordinal (3ℕ)"
    and "RK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
  unfolding RK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas RK23_components' = RK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = RK23_components'(3,4)

end

lemmas [cat_Kan_cs_simps] = is_functor.RK23_components'(3,4)


subsubsection‹Object map›

mk_VLambda RK23_components(1)
  |vsv RK23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app RK23_ObjMap_app|

lemma RK23_ObjMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
  unfolding RK23_components assms cat_ordinal_components by simp

lemma RK23_ObjMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1ℕ"
  shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1ℕ⦈"
  unfolding RK23_components assms cat_ordinal_components by simp

lemma RK23_ObjMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2ℕ"
  shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1ℕ⦈"
  unfolding RK23_components assms cat_ordinal_components by simp


subsubsection‹Arrow map›

mk_VLambda RK23_components(2)
  |vsv RK23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app RK23_ArrMap_app|

lemma RK23_ArrMap_app_00[cat_Kan_cs_simps]:
  assumes "f = [0, 0]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_01[cat_Kan_cs_simps]:
  assumes "f = [0, 1ℕ]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_02[cat_Kan_cs_simps]:
  assumes "f = [0, 2ℕ]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_11[cat_Kan_cs_simps]:
  assumes "f = [1ℕ, 1ℕ]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_12[cat_Kan_cs_simps]:
  assumes "f = [1ℕ, 2ℕ]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set   
          cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_22[cat_Kan_cs_simps]:
  assumes "f = [2ℕ, 2ℕ]∘"
  shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro: 
          nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by simp
qed


subsubsection‹‹RK23› is a functor›

lemma cat_RK23_is_functor:
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
  shows "RK23 𝔉 : cat_ordinal (3ℕ) ↦↦Cα ℭ"
proof-

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms(1))

  from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms)

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (RK23 𝔉)" unfolding RK23_def by auto
    show "vcard (RK23 𝔉) = 4ℕ" unfolding RK23_def by (simp add: nat_omega_simps)
    show "ℛ∘ (RK23 𝔉⦇ObjMap⦈) ⊆∘ ℭ⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
      fix x assume prems: "x ∈∘ cat_ordinal (3ℕ)⦇Obj⦈"
      then consider ‹x = 0› | ‹x = 1ℕ› | ‹x = 2ℕ›
        unfolding cat_ordinal_cs_simps three by auto
      then show "RK23 𝔉⦇ObjMap⦈⦇x⦈ ∈∘ ℭ⦇Obj⦈" 
        by cases
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set 
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_intro: cat_Kan_cs_intros)
    show "RK23 𝔉⦇ArrMap⦈⦇f⦈ : RK23 𝔉⦇ObjMap⦈⦇a⦈ ↦ℭ RK23 𝔉⦇ObjMap⦈⦇b⦈"
      if "f : a ↦cat_ordinal (3ℕ) b" for a b f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_Kan_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show 
      "RK23 𝔉⦇ArrMap⦈⦇g ∘Acat_ordinal (3ℕ) f⦈ =
        RK23 𝔉⦇ArrMap⦈⦇g⦈ ∘Aℭ RK23 𝔉⦇ArrMap⦈⦇f⦈"
      if "g : b ↦cat_ordinal (3ℕ) c" and "f : a ↦cat_ordinal (3ℕ) b"
      for b c g a f
      using 0123 that 
      by (elim cat_ordinal_3_is_arrE; simp only:; (solves‹simp›)?) (*slow*)
        (
          cs_concl 
            cs_simp: 
              cat_ordinal_cs_simps 
              cat_Kan_cs_simps 
              𝔉.cf_ArrMap_Comp[symmetric]
            cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
        )+
    show "RK23 𝔉⦇ArrMap⦈⦇cat_ordinal (3ℕ)⦇CId⦈⦇c⦈⦈ = ℭ⦇CId⦈⦇RK23 𝔉⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ cat_ordinal (3ℕ)⦇Obj⦈" for c
    proof-
      from that consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ›
        unfolding cat_ordinal_components three by auto
      then show ?thesis
        by (cases, use 0123 in ‹simp_all only:›)
          (
            cs_concl
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                is_functor.cf_ObjMap_CId[symmetric]  
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma cat_RK23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
    and "𝔄' = cat_ordinal (3ℕ)"
  shows "RK23 𝔉 : 𝔄' ↦↦Cα ℭ"
  using assms(1) unfolding assms(2) by (rule cat_RK23_is_functor)


subsubsection‹The fundamental property of ‹RK23››

lemma cf_comp_RK23_𝔎23[cat_Kan_cs_simps]: 
  assumes "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ"
  shows "RK23 𝔉 ∘CF 𝔎23 = 𝔉"
proof-

  interpret 𝔉: is_functor α ‹cat_ordinal (2ℕ)› ℭ 𝔉 by (rule assms(1))
  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor α ‹cat_ordinal (3ℕ)› ℭ ‹RK23 𝔉›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI)
    show "𝔉 : cat_ordinal (2ℕ) ↦↦Cα ℭ" by (rule assms)
    have ObjMap_dom_lhs: "𝒟∘ ((RK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈) = 2ℕ"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
        )
    have ObjMap_dom_rhs: "𝒟∘ (𝔉⦇ObjMap⦈) = 2ℕ"
      by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
    show "(RK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume prems: "a ∈∘ 2ℕ"
      then consider ‹a = 0› | ‹a = 1ℕ› by force
      then show "(RK23 𝔉 ∘CF 𝔎23)⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇a⦈"
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl
              cs_simp:
                omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
    have ArrMap_dom_lhs: "𝒟∘ ((RK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈) = cat_ordinal (2ℕ)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have ArrMap_dom_rhs: "𝒟∘ (𝔉⦇ArrMap⦈) = cat_ordinal (2ℕ)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(RK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume prems: "f ∈∘ cat_ordinal (2ℕ)⦇Arr⦈"
      then obtain a b where "f : a ↦cat_ordinal (2ℕ) b" by auto
      then show "(RK23 𝔉 ∘CF 𝔎23)⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇f⦈"
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
  qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

qed



subsection‹
‹RK_σ23›: towards the universal property of the right Kan extension along ‹𝔎23›
›


subsubsection‹Definition and elementary properties›

definition RK_σ23 :: "V ⇒ V ⇒ V ⇒ V"
  where "RK_σ23 𝔗 ε' 𝔉' =
    [
      (
        λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
         if a = 0 ⇒ ε'⦇NTMap⦈⦇0⦈
          | a = 1ℕ ⇒ ε'⦇NTMap⦈⦇1ℕ⦈ ∘A𝔗⦇HomCod⦈ 𝔉'⦇ArrMap⦈⦇1ℕ, 2ℕ⦈∙
          | a = 2ℕ ⇒ ε'⦇NTMap⦈⦇1ℕ⦈
          | otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
      ),
      𝔉',
      RK23 𝔗,
      cat_ordinal (3ℕ),
      𝔉'⦇HomCod⦈
    ]∘"


text‹Components.›

lemma RK_σ23_components:
  shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈ =
    (
      λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
        if a = 0 ⇒ ε'⦇NTMap⦈⦇0⦈
         | a = 1ℕ ⇒ ε'⦇NTMap⦈⦇1ℕ⦈ ∘A𝔗⦇HomCod⦈ 𝔉'⦇ArrMap⦈⦇1ℕ, 2ℕ⦈∙
         | a = 2ℕ ⇒ ε'⦇NTMap⦈⦇1ℕ⦈
         | otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
    )"
    and "RK_σ23 𝔗 ε' 𝔉'⦇NTDom⦈ = 𝔉'"
    and "RK_σ23 𝔗 ε' 𝔉'⦇NTCod⦈ = RK23 𝔗"
    and "RK_σ23 𝔗 ε' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3ℕ)"
    and "RK_σ23 𝔗 ε' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
  unfolding RK_σ23_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔉' 𝔗  
  assumes 𝔉': "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
    and 𝔗: "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
begin

interpretation 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule 𝔗)

lemmas RK_σ23_components' = 
  RK_σ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = RK_σ23_components'(2-5)

end


subsubsection‹Natural transformation map›

mk_VLambda RK_σ23_components(1)
  |vsv RK_σ23_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK_σ23_NTMap_vdomain[cat_Kan_cs_simps]|
  |app RK_σ23_NTMap_app|

lemma RK_σ23_NTMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇0⦈"
  using assms unfolding RK_σ23_components cat_ordinal_cs_simps by simp

lemma (in is_functor) RK_σ23_NTMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1ℕ"
  shows "RK_σ23 𝔉 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇1ℕ⦈ ∘A𝔅 𝔉'⦇ArrMap⦈⦇1ℕ, 2ℕ⦈∙"
  using assms 
  unfolding RK_σ23_components cat_ordinal_cs_simps cat_cs_simps 
  by simp

lemmas [cat_Kan_cs_simps] = is_functor.RK_σ23_NTMap_app_1

lemma RK_σ23_NTMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2ℕ"
  shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇1ℕ⦈"
  using assms unfolding RK_σ23_components cat_ordinal_cs_simps by simp


subsubsection‹‹RK_σ23› is a natural transformation›

lemma RK_σ23_is_ntcf:
  assumes "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄" 
    and "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "ε' : 𝔉' ∘CF 𝔎23 ↦CF 𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
proof-
 
  interpret 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule assms(1))
  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(2))
  interpret ε': is_ntcf α ‹cat_ordinal (2ℕ)› 𝔄 ‹𝔉' ∘CF 𝔎23› 𝔗 ε' 
    by (rule assms(3))

  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor α ‹cat_ordinal (3ℕ)› 𝔄 ‹RK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  from 0123 have [cat_cs_simps]: "𝔗⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙ = 𝔄⦇CId⦈⦇𝔗⦇ObjMap⦈⦇1ℕ⦈⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric] 
          cs_intro: cat_cs_intros
      )

  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence (RK_σ23 𝔗 ε' 𝔉')" unfolding RK_σ23_def by simp
    show "vcard (RK_σ23 𝔗 ε' 𝔉') = 5ℕ"
      unfolding RK_σ23_def by (simp_all add: nat_omega_simps)
    show "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ : 𝔉'⦇ObjMap⦈⦇a⦈ ↦𝔄 RK23 𝔗⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ cat_ordinal (3ℕ)⦇Obj⦈" for a
    proof-
      from that consider ‹a = 0› | ‹a = 1ℕ› | ‹a = 2ℕ›
        unfolding cat_ordinal_cs_simps three by auto
      from this 0123 show ?thesis
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_cs_intros
                cat_ordinal_cs_intros
                cat_Kan_cs_intros 
                nat_omega_intros
          )+
    qed
    show
      "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇b⦈ ∘A𝔄 𝔉'⦇ArrMap⦈⦇f⦈ =
        RK23 𝔗⦇ArrMap⦈⦇f⦈ ∘A𝔄 RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈"
      if "f : a ↦cat_ordinal (3ℕ) b" for a b f
      using that 0123
      by  (elim cat_ordinal_3_is_arrE, use nothing in ‹simp_all only:›) (*slow*)
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_ordinal_cs_simps
              𝔉'.cf_ArrMap_Comp[symmetric]
              𝔉'.HomCod.cat_Comp_assoc
              ε'.ntcf_Comp_commute[symmetric]
              cat_Kan_cs_simps 
            cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
        )+
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma RK_σ23_is_ntcf'[cat_Kan_cs_intros]:
  assumes "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄" 
    and "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "ε' : 𝔉' ∘CF 𝔎23 ↦CF 𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "𝔊' = 𝔉'"
    and "ℌ' = RK23 𝔗"
    and "ℭ' = cat_ordinal (3ℕ)"
  shows "RK_σ23 𝔗 ε' 𝔉' : 𝔊' ↦CF ℌ': ℭ' ↦↦Cα 𝔄"
  using assms(1-3) unfolding assms(4-6) by (rule RK_σ23_is_ntcf)



subsection‹The right Kan extension along ‹𝔎23››

lemma ε23_is_cat_rKe:
  assumes "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "ntcf_id 𝔗 :
    RK23 𝔗 ∘CF 𝔎23 ↦CF.rKeα 𝔗 : cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(1))
  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor α ‹cat_ordinal (3ℕ)› 𝔄 ‹RK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  from 0123 have [cat_cs_simps]: "𝔗⦇ArrMap⦈⦇1ℕ, 1ℕ⦈∙ = 𝔄⦇CId⦈⦇𝔗⦇ObjMap⦈⦇1ℕ⦈⦈"
    by
      (
        cs_concl
          cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
          cs_intro: cat_cs_intros
      )

  show ?thesis
  proof(intro is_cat_rKeI')
    
    fix 𝔉' ε' assume prems:
      "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
      "ε' : 𝔉' ∘CF 𝔎23 ↦CF 𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"

    interpret 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule prems(1))
    interpret ε': is_ntcf α ‹cat_ordinal (2ℕ)› 𝔄 ‹𝔉' ∘CF 𝔎23› 𝔗 ε' 
      by (rule prems(2))
    interpret RK_σ23: is_ntcf α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' ‹RK23 𝔗› ‹RK_σ23 𝔗 ε' 𝔉'›
      by (intro RK_σ23_is_ntcf prems assms)

    show "∃!σ.
      σ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄 ∧
      ε' = ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23)"
    proof(intro ex1I conjI; (elim conjE)?)
      show "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
        by (intro RK_σ23.is_ntcf_axioms)
      show "ε' = ntcf_id 𝔗 ∙NTCF (RK_σ23 𝔗 ε' 𝔉' ∘NTCF-CF 𝔎23)"
      proof(rule ntcf_eqI)
        show "ε' : 𝔉' ∘CF 𝔎23 ↦CF 𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄" 
          by (intro prems)
        then have dom_lhs: "𝒟∘ (ε'⦇NTMap⦈) = 2ℕ"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show rhs:
          "ntcf_id 𝔗 ∙NTCF (RK_σ23 𝔗 ε' 𝔉' ∘NTCF-CF 𝔎23) :
            𝔉' ∘CF 𝔎23 ↦CF 𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
          by
            (
              cs_concl 
                cs_simp: cat_Kan_cs_simps cat_cs_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros
            )
        then have dom_rhs: 
          "𝒟∘ ((ntcf_id 𝔗 ∙NTCF (RK_σ23 𝔗 ε' 𝔉' ∘NTCF-CF 𝔎23))⦇NTMap⦈) = 2ℕ"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show "ε'⦇NTMap⦈ = (ntcf_id 𝔗 ∙NTCF (RK_σ23 𝔗 ε' 𝔉' ∘NTCF-CF 𝔎23))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 2ℕ"
          then consider ‹a = 0› | ‹a = 1ℕ› unfolding two by auto
          then show 
            "ε'⦇NTMap⦈⦇a⦈ =
              (ntcf_id 𝔗 ∙NTCF (RK_σ23 𝔗 ε' 𝔉' ∘NTCF-CF 𝔎23))⦇NTMap⦈⦇a⦈"
            by (cases; use nothing in ‹simp_all only:›)
              (
                cs_concl
                  cs_simp:
                    omega_of_set
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_ordinal_cs_simps
                  cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
              )+
        qed (use rhs in ‹cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros›)+
      qed simp_all

      fix σ assume prems': 
        "σ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
        "ε' = ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23)"

      interpret σ: is_ntcf α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' ‹RK23 𝔗› σ 
        by (rule prems'(1))

      from prems'(2) have 
        "ε'⦇NTMap⦈⦇0⦈ = (ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23))⦇NTMap⦈⦇0⦈"
        by auto
      then have [cat_cs_simps]: "ε'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
        by
          (
            cs_prems
              cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps 
              cs_intro: cat_cs_intros nat_omega_intros
          )
      from prems'(2) have
        "ε'⦇NTMap⦈⦇1ℕ⦈ = (ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23))⦇NTMap⦈⦇1ℕ⦈"
        by auto
      then have [cat_cs_simps]: "ε'⦇NTMap⦈⦇1ℕ⦈ = σ⦇NTMap⦈⦇2ℕ⦈"
        by
          (
            cs_prems
              cs_simp:
                omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )

      show "σ = RK_σ23 𝔗 ε' 𝔉'"
      proof(rule ntcf_eqI)
        show "σ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
          by (rule prems'(1))
        then have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = 3ℕ"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        show "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        then have dom_rhs: "𝒟∘ (RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈) = 3ℕ"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        from 0123 have 013: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (3ℕ) 1ℕ"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 123: "[1ℕ, 2ℕ]∘ : 1ℕ ↦cat_ordinal (3ℕ) 2ℕ"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)

        from σ.ntcf_Comp_commute[OF 123] 013 0123 
        have [symmetric, cat_Kan_cs_simps]:
          "σ⦇NTMap⦈⦇2ℕ⦈ ∘A𝔄 𝔉'⦇ArrMap⦈ ⦇1ℕ, 2ℕ⦈∙ = σ⦇NTMap⦈⦇1ℕ⦈"
          by
            (
              cs_prems 
                cs_simp: cat_cs_simps cat_Kan_cs_simps RK23_ArrMap_app_12 
                cs_intro: cat_cs_intros
            )
        show "σ⦇NTMap⦈ = RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 3ℕ"
          then consider ‹a = 0› | ‹a = 1ℕ› | ‹a = 2ℕ› unfolding three by auto
          then show "σ⦇NTMap⦈⦇a⦈ = RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈"
            by (cases; use nothing in ‹simp_all only:›) 
              (cs_concl cs_simp: cat_cs_simps cat_Kan_cs_simps)+
        qed auto
      qed simp_all

    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed



subsection‹
‹LK_σ23›: towards the universal property of the left Kan extension along ‹𝔎23›
›


subsubsection‹Definition and elementary properties›

definition LK_σ23 :: "V ⇒ V ⇒ V ⇒ V"
  where "LK_σ23 𝔗 η' 𝔉' =
    [
      (
        λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
         if a = 0 ⇒ η'⦇NTMap⦈⦇0⦈
          | a = 1ℕ ⇒ 𝔉'⦇ArrMap⦈⦇0, 1ℕ⦈∙ ∘A𝔗⦇HomCod⦈ η'⦇NTMap⦈⦇0⦈
          | a = 2ℕ ⇒ η'⦇NTMap⦈⦇1ℕ⦈
          | otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
      ),
      LK23 𝔗,
      𝔉',
      cat_ordinal (3ℕ),
      𝔉'⦇HomCod⦈
    ]∘"


text‹Components.›

lemma LK_σ23_components:
  shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈ =
    (
      λa∈∘cat_ordinal (3ℕ)⦇Obj⦈.
        if a = 0 ⇒ η'⦇NTMap⦈⦇0⦈
         | a = 1ℕ ⇒ 𝔉'⦇ArrMap⦈⦇0, 1ℕ⦈∙ ∘A𝔗⦇HomCod⦈ η'⦇NTMap⦈⦇0⦈
         | a = 2ℕ ⇒ η'⦇NTMap⦈⦇1ℕ⦈
         | otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
    )"
    and "LK_σ23 𝔗 η' 𝔉'⦇NTDom⦈ = LK23 𝔗"
    and "LK_σ23 𝔗 η' 𝔉'⦇NTCod⦈ = 𝔉'"
    and "LK_σ23 𝔗 η' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3ℕ)"
    and "LK_σ23 𝔗 η' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
  unfolding LK_σ23_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔉' 𝔗  
  assumes 𝔉': "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
    and 𝔗: "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
begin

interpretation 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule 𝔗)

lemmas LK_σ23_components' = 
  LK_σ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = LK_σ23_components'(2-5)

end


subsubsection‹Natural transformation map›

mk_VLambda LK_σ23_components(1)
  |vsv LK_σ23_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK_σ23_NTMap_vdomain[cat_Kan_cs_simps]|
  |app LK_σ23_NTMap_app|

lemma LK_σ23_NTMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ = η'⦇NTMap⦈⦇0⦈"
  using assms unfolding LK_σ23_components cat_ordinal_cs_simps by simp

lemma (in is_functor) LK_σ23_NTMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1ℕ"
  shows "LK_σ23 𝔉 η' 𝔉'⦇NTMap⦈⦇a⦈ = 𝔉'⦇ArrMap⦈⦇0, 1ℕ⦈∙ ∘A𝔅 η'⦇NTMap⦈⦇0⦈"
  using assms unfolding LK_σ23_components cat_ordinal_cs_simps cat_cs_simps by simp

lemmas [cat_Kan_cs_simps] = is_functor.LK_σ23_NTMap_app_1

lemma LK_σ23_NTMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2ℕ"
  shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ = η'⦇NTMap⦈⦇1ℕ⦈"
  using assms unfolding LK_σ23_components cat_ordinal_cs_simps by simp


subsubsection‹‹LK_σ23› is a natural transformation›

lemma LK_σ23_is_ntcf:
  assumes "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄" 
    and "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
proof-
 
  interpret 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule assms(1))
  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(2))
  interpret η': is_ntcf α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 ‹𝔉' ∘CF 𝔎23› η' 
    by (rule assms(3))

  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor α ‹cat_ordinal (3ℕ)› 𝔄 ‹LK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
 
  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence (LK_σ23 𝔗 η' 𝔉')" unfolding LK_σ23_def by simp
    show "vcard (LK_σ23 𝔗 η' 𝔉') = 5ℕ"
      unfolding LK_σ23_def by (simp_all add: nat_omega_simps)
    show "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ : LK23 𝔗⦇ObjMap⦈⦇a⦈ ↦𝔄 𝔉'⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ cat_ordinal (3ℕ)⦇Obj⦈" for a
    proof-
      from that consider ‹a = 0› | ‹a = 1ℕ› | ‹a = 2ℕ›
        unfolding cat_ordinal_cs_simps three by auto
      from this 0123 show 
        "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ : LK23 𝔗⦇ObjMap⦈⦇a⦈ ↦𝔄 𝔉'⦇ObjMap⦈⦇a⦈"
        by (cases, use nothing in ‹simp_all only:›)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_cs_intros 
                cat_ordinal_cs_intros 
                cat_Kan_cs_intros
                nat_omega_intros
          )+
    qed
    show
      "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇b⦈ ∘A𝔄 LK23 𝔗⦇ArrMap⦈⦇f⦈ =
        𝔉'⦇ArrMap⦈⦇f⦈ ∘A𝔄 LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈"
      if "f : a ↦cat_ordinal (3ℕ) b" for a b f
      using that 0123 
      by (elim cat_ordinal_3_is_arrE, use nothing in ‹simp_all only:›) (*slow*)
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_ordinal_cs_simps
              𝔉'.cf_ArrMap_Comp[symmetric]
              𝔉'.HomCod.cat_Comp_assoc[symmetric]
              η'.ntcf_Comp_commute
              cat_Kan_cs_simps
            cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
        )+
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma LK_σ23_is_ntcf'[cat_Kan_cs_intros]:
  assumes "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
    and "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
    and "𝔊' = LK23 𝔗"
    and "ℌ' = 𝔉'"
    and "ℭ' = cat_ordinal (3ℕ)"
  shows "LK_σ23 𝔗 η' 𝔉' : 𝔊' ↦CF ℌ': ℭ' ↦↦Cα 𝔄"
  using assms(1-3) unfolding assms(4-6) by (rule LK_σ23_is_ntcf)



subsection‹The left Kan extension along ‹𝔎23››

lemma η23_is_cat_rKe:
  assumes "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "ntcf_id 𝔗 :
    𝔗 ↦CF.lKeα LK23 𝔗 ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(1))
  interpret 𝔎23: is_functor α ‹cat_ordinal (2ℕ)› ‹cat_ordinal (3ℕ)› ‹𝔎23›
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor α ‹cat_ordinal (3ℕ)› 𝔄 ‹LK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(intro is_cat_lKeI')
    fix 𝔉' η' assume prems:
      "𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
      "η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"

    interpret 𝔉': is_functor α ‹cat_ordinal (3ℕ)› 𝔄 𝔉' by (rule prems(1))
    interpret η': is_ntcf α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 ‹𝔉' ∘CF 𝔎23› η' 
      by (rule prems(2))
    interpret LK_σ23: is_ntcf α ‹cat_ordinal (3ℕ)› 𝔄 ‹LK23 𝔗› 𝔉' ‹LK_σ23 𝔗 η' 𝔉'›
      by (intro LK_σ23_is_ntcf prems assms)

    show "∃!σ.
      σ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄 ∧
      η' = σ ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗"
    proof(intro ex1I conjI; (elim conjE)?)
      show "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
        by (intro LK_σ23.is_ntcf_axioms)
      show "η' = LK_σ23 𝔗 η' 𝔉' ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗"
      proof(rule ntcf_eqI)
        show "η' : 𝔗 ↦CF 𝔉' ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦↦Cα 𝔄" 
          by (intro prems)
        then have dom_lhs: "𝒟∘ (η'⦇NTMap⦈) = 2ℕ"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show rhs:
          "LK_σ23 𝔗 η' 𝔉' ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗 :
            𝔗 ↦CF 𝔉' ∘CF 𝔎23 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
          by 
            (
              cs_concl 
                cs_simp: cat_Kan_cs_simps cat_cs_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros
            )
        then have dom_rhs: 
          "𝒟∘ ((LK_σ23 𝔗 η' 𝔉' ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗)⦇NTMap⦈) = 2ℕ"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show "η'⦇NTMap⦈ = (LK_σ23 𝔗 η' 𝔉' ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗)⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 2ℕ"
          then consider ‹a = 0› | ‹a = 1ℕ› unfolding two by auto
          then show 
            "η'⦇NTMap⦈⦇a⦈ =
              (LK_σ23 𝔗 η' 𝔉' ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗)⦇NTMap⦈⦇a⦈"
            by (cases; use nothing in ‹simp_all only:›)
              (
                cs_concl 
                  cs_simp: 
                    omega_of_set 
                    cat_Kan_cs_simps 
                    cat_cs_simps 
                    cat_ordinal_cs_simps 
                  cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
              )+
        qed (use rhs in ‹cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros›)+
      qed simp_all

      fix σ assume prems': 
        "σ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
        "η' = σ ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗"

      interpret σ: is_ntcf α ‹cat_ordinal (3ℕ)› 𝔄 ‹LK23 𝔗› 𝔉' σ 
        by (rule prems'(1))

      from prems'(2) have 
        "η'⦇NTMap⦈⦇0⦈ = (σ ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗)⦇NTMap⦈⦇0⦈"
        by auto
      then have [cat_cs_simps]: "η'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
        by 
          (
            cs_prems 
              cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps 
              cs_intro: cat_cs_intros nat_omega_intros
          )
      from prems'(2) have
        "η'⦇NTMap⦈⦇1ℕ⦈ = (σ ∘NTCF-CF 𝔎23 ∙NTCF ntcf_id 𝔗)⦇NTMap⦈⦇1ℕ⦈"
        by auto
      then have [cat_cs_simps]: "η'⦇NTMap⦈⦇1ℕ⦈ = σ⦇NTMap⦈⦇2ℕ⦈"
        by
          (
            cs_prems
              cs_simp:
                omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )

      show "σ = LK_σ23 𝔗 η' 𝔉'"
      proof(rule ntcf_eqI)

        show "σ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄" 
          by (rule prems'(1))
        then have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = 3ℕ"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        show "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3ℕ) ↦↦Cα 𝔄"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        then have dom_rhs: "𝒟∘ (LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈) = 3ℕ"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        from 0123 have 012: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (2ℕ) 1ℕ"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 013: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (3ℕ) 1ℕ"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 00: "[0, 0]∘ = (cat_ordinal (2ℕ))⦇CId⦈⦇0⦈"
          by (cs_concl cs_simp: cat_ordinal_cs_simps)
        from σ.ntcf_Comp_commute[OF 013] 013 0123 
        have [symmetric, cat_Kan_cs_simps]:
          "σ⦇NTMap⦈⦇1ℕ⦈ = 𝔉'⦇ArrMap⦈⦇0, 1ℕ⦈∙ ∘A𝔄 σ⦇NTMap⦈⦇0⦈"
          by
            (
              cs_prems
                cs_simp: cat_cs_simps cat_Kan_cs_simps 00 LK23_ArrMap_app_01
                cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
            )

        show "σ⦇NTMap⦈ = LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 3ℕ"
          then consider ‹a = 0› | ‹a = 1ℕ› | ‹a = 2ℕ› unfolding three by auto
          then show "σ⦇NTMap⦈⦇a⦈ = LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈"
            by (cases; use nothing in ‹simp_all only:›) 
              (
                cs_concl 
                  cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_Kan_cs_simps 
                  cs_intro: cat_cs_intros
              )+
        qed auto
      qed simp_all

    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed



subsection‹Pointwise Kan extensions along ‹𝔎23››

lemma ε23_is_cat_pw_rKe:
  assumes "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "ntcf_id 𝔗 :
    RK23 𝔗 ∘CF 𝔎23 ↦CF.rKe.pwα 𝔗 :
    cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(1))

  show ?thesis
  proof(intro is_cat_pw_rKeI ε23_is_cat_rKe[OF assms])

    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    
    show
      "ntcf_id 𝔗 : 
        RK23 𝔗 ∘CF 𝔎23 ↦CF.rKeα 𝔗 :
        cat_ordinal (2ℕ) ↦C
        cat_ordinal (3ℕ) ↦C
        (HomO.Cα𝔄(a,-) : 𝔄 ↦↦C cat_Set α)"
    proof(intro is_cat_rKe_preservesI ε23_is_cat_rKe[OF assms])
      from prems show "HomO.Cα𝔄(a,-) : 𝔄 ↦↦Cα cat_Set α"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 :
        (HomO.Cα𝔄(a,-) ∘CF RK23 𝔗) ∘CF 𝔎23 ↦CF.rKeα HomO.Cα𝔄(a,-) ∘CF 𝔗 :
        cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C cat_Set α"
      proof(intro is_cat_rKeI')
        show "𝔎23 : cat_ordinal (2ℕ) ↦↦Cα cat_ordinal (3ℕ)"
          by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
        from prems show
          "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        from prems show 
          "HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 :
            HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 ∘CF 𝔎23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
            cat_ordinal (2ℕ) ↦↦Cα cat_Set α"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_Kan_cs_intros
            )

        fix 𝔊' ε' assume prems':
          "𝔊' : cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
          "ε' :
            𝔊' ∘CF 𝔎23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
            cat_ordinal (2ℕ) ↦↦Cα cat_Set α"

        interpret 𝔊': is_functor α ‹cat_ordinal (3ℕ)› ‹cat_Set α› 𝔊' 
          by (rule prems'(1))
        interpret ε': is_ntcf
          α
          ‹cat_ordinal (2ℕ)›
          ‹cat_Set α›
          ‹𝔊' ∘CF 𝔎23›
          ‹HomO.Cα𝔄(a,-) ∘CF 𝔗›
          ε'
          by (rule prems'(2))

        show "∃!σ.
          σ :
            𝔊' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 :
            cat_ordinal (3ℕ) ↦↦Cα cat_Set α ∧
          ε' = HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23)"
        proof(intro ex1I conjI; (elim conjE)?)
          have [cat_Kan_cs_simps]: 
            "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 = RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)"
          proof(rule cf_eqI)
            from prems show lhs: "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps
                    cs_intro: cat_cs_intros cat_Kan_cs_intros
                )
            from prems show rhs: "RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) : 
              cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps
                    cs_intro: cat_cs_intros cat_Kan_cs_intros
                )
            from lhs prems have ObjMap_dom_lhs: 
              "𝒟∘ ((HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMap⦈) = 3ℕ"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ObjMap_dom_rhs:
              "𝒟∘ ((RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗))⦇ObjMap⦈) = 3ℕ"
              by 
                (
                  cs_concl 
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros 
                )
            show 
              "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMap⦈ =
                RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
              fix c assume prems'': "c ∈∘ 3ℕ"
              with 0123 consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ› by force
              from this prems prems'' 0123 show 
                "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMap⦈⦇c⦈ =
                  RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ObjMap⦈⦇c⦈"
                by (cases; use nothing in ‹simp_all only:›)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps
                        cat_cs_simps
                        cat_op_simps
                        cat_Kan_cs_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros
                 )+
            qed 
              (
                use prems in ‹
                  cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros
                  ›
              )+
            from lhs prems have ArrMap_dom_lhs: 
              "𝒟∘ ((HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMap⦈) = 
                cat_ordinal (3ℕ)⦇Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ArrMap_dom_rhs:
              "𝒟∘ ((RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗))⦇ArrMap⦈) = 
                cat_ordinal (3ℕ)⦇Arr⦈"
              by 
                (
                  cs_concl 
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros 
                )
            show 
              "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMap⦈ =
                RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              fix f assume prems'': "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
              then obtain a' b' where "f : a' ↦cat_ordinal (3ℕ) b'" by auto
              from this 0123 prems show 
                "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMap⦈⦇f⦈ =
                  RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ArrMap⦈⦇f⦈"
                by (*slow*)
                  (
                    elim cat_ordinal_3_is_arrE;
                    use nothing in ‹simp_all only:›
                  )
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
                      cs_intro:
                        cat_ordinal_cs_intros
                        cat_Kan_cs_intros
                        cat_cs_intros
                        nat_omega_intros
                  )+
            qed 
              (
                use prems in 
                  ‹cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros›
              )+
          qed simp_all

          show "RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' : 
            𝔊' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
            cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
            by (intro RK_σ23_is_ntcf')
              (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
          show "ε' = 
            HomO.Cα𝔄(a,-) ∘CF-NTCF 
            ntcf_id 𝔗 ∙NTCF 
            (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' ∘NTCF-CF 𝔎23)"
          proof(rule ntcf_eqI)
            show "ε' :
              𝔊' ∘CF 𝔎23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
              cat_ordinal (2ℕ) ↦↦Cα cat_Set α"
              by (intro prems')
            then have dom_lhs: "𝒟∘ (ε'⦇NTMap⦈) = 2ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from prems show 
              "HomO.Cα𝔄(a,-) ∘CF-NTCF 
                ntcf_id 𝔗 ∙NTCF 
                (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' ∘NTCF-CF 𝔎23) :
              𝔊' ∘CF 𝔎23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
              cat_ordinal (2ℕ) ↦↦Cα cat_Set α"
              by
                (
                  cs_concl
                    cs_simp: cat_Kan_cs_simps
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            then have dom_rhs: 
              "𝒟∘ 
                (
                  (HomO.Cα𝔄(a,-) ∘CF-NTCF
                  ntcf_id 𝔗 ∙NTCF 
                  (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' ∘NTCF-CF 𝔎23)
                )⦇NTMap⦈) = 2ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "ε'⦇NTMap⦈ =
              (
                HomO.Cα𝔄(a,-) ∘CF-NTCF
                ntcf_id 𝔗 ∙NTCF
                (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' ∘NTCF-CF 𝔎23)
              )⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume prems'': "c ∈∘ 2ℕ"
              then consider ‹c = 0› | ‹c = 1ℕ› unfolding two by auto
              from this prems 0123 show "ε'⦇NTMap⦈⦇c⦈ =
                (
                  HomO.Cα𝔄(a,-) ∘CF-NTCF 
                  ntcf_id 𝔗 ∙NTCF 
                  (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' ∘NTCF-CF 𝔎23)
                )⦇NTMap⦈⦇c⦈"
                by (cases; use nothing in ‹simp_all only:›)
                  (
                    cs_concl
                      cs_simp: 
                        cat_Kan_cs_simps 
                        cat_ordinal_cs_simps 
                        cat_cs_simps
                        cat_op_simps
                        cat_Set_components(1)
                      cs_intro:
                        cat_Kan_cs_intros
                        cat_cs_intros
                        cat_prod_cs_intros
                        𝔗.HomCod.cat_Hom_in_Vset
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+

          qed simp_all

          fix σ assume prems'':
            "σ :
              𝔊' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 :
              cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
            "ε' =
              HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23)"

          interpret σ: is_ntcf 
            α ‹cat_ordinal (3ℕ)› ‹cat_Set α› 𝔊' ‹HomO.Cα𝔄(a,-) ∘CF RK23 𝔗› σ
            by (rule prems''(1))

          from prems''(2) have "ε'⦇NTMap⦈⦇0⦈ =
            (HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 ∙NTCF (σ ∘NTCF-CF 𝔎23))⦇NTMap⦈⦇0⦈"
            by auto
          from this prems 0123 have ε'_NTMap_app_0: "ε'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_cs_simps
                    cat_Kan_cs_simps
                    cat_op_simps
                    𝔎23_ObjMap_app_0
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )
          from 0123 have 01: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (2ℕ) 1ℕ"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps
                  cs_intro: cat_ordinal_cs_intros nat_omega_intros
              )
          from prems''(2) have 
            "ε'⦇NTMap⦈⦇1ℕ⦈ =
              (
                HomO.Cα𝔄(a,-) ∘CF-NTCF
                ntcf_id 𝔗 ∙NTCF
                (σ ∘NTCF-CF 𝔎23)
              )⦇NTMap⦈⦇1ℕ⦈"
            by auto
          from this prems 0123 have ε'_NTMap_app_1:  
            "ε'⦇NTMap⦈⦇1ℕ⦈ = σ⦇NTMap⦈⦇2ℕ⦈"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_cs_simps
                    cat_Kan_cs_simps
                    cat_op_simps
                    𝔎23_ObjMap_app_1
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )

          from 0123 have 012: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (2ℕ) 1ℕ"
            by 
              (
                cs_concl cs_simp: cs_intro:
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 013: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (3ℕ) 1ℕ"
            by 
              ( 
                cs_concl cs_simp: cs_intro: 
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 123: "[1ℕ, 2ℕ]∘ : 1ℕ ↦cat_ordinal (3ℕ) 2ℕ"
            by 
              (
                cs_concl cs_simp: cs_intro:
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 11: "[1ℕ, 1ℕ]∘ = (cat_ordinal (2ℕ))⦇CId⦈⦇1ℕ⦈"
            by (cs_concl cs_simp: cat_ordinal_cs_simps)

          from σ.ntcf_Comp_commute[OF 123] prems 012 013 
          have [cat_Kan_cs_simps]:
            "ε'⦇NTMap⦈⦇1ℕ⦈ ∘Acat_Set α 𝔊'⦇ArrMap⦈⦇1ℕ, 2ℕ⦈∙ = σ⦇NTMap⦈⦇1ℕ⦈"
            by (*slow*)
              (
                cs_prems 1
                  cs_simp:
                    cat_cs_simps
                    cat_Kan_cs_simps
                    ε'_NTMap_app_1[symmetric]
                    is_functor.cf_ObjMap_CId
                    RK23_ArrMap_app_12
                    11
                  cs_intro: cat_cs_intros nat_omega_intros 
              )
          
          show "σ = RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊'"
          proof(rule ntcf_eqI)

            show σ: "σ : 
              𝔊' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
              by (rule prems''(1))
            then have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = 3ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊' :
              𝔊' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3ℕ) ↦↦Cα cat_Set α"
              by 
                (
                  cs_concl 
                    cs_simp: cat_Kan_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            then have dom_rhs: 
              "𝒟∘ (RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊'⦇NTMap⦈) = 3ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "σ⦇NTMap⦈ = RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊'⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume "c ∈∘ 3ℕ"
              then consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ›  
                unfolding three by auto
              from this 0123 show
                "σ⦇NTMap⦈⦇c⦈ = RK_σ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) ε' 𝔊'⦇NTMap⦈⦇c⦈"
                by (cases; use nothing in ‹simp_all only:›)
                  (
                    cs_concl cs_simp:
                      cat_Kan_cs_simps ε'_NTMap_app_1 ε'_NTMap_app_0
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+

          qed simp_all

        qed

      qed

    qed

  qed

qed

lemma η23_is_cat_pw_lKe:
  assumes "𝔗 : cat_ordinal (2ℕ) ↦↦Cα 𝔄"
  shows "ntcf_id 𝔗 :
    𝔗 ↦CF.lKe.pwα LK23 𝔗 ∘CF 𝔎23 :
    cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor α ‹cat_ordinal (2ℕ)› 𝔄 𝔗 by (rule assms(1))

  from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3ℕ)›
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  from 0123 have 002: "[0, 0]∘ : 0 ↦cat_ordinal (2ℕ) 0"
    by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_cs_intros)

  show ?thesis
  proof(intro is_cat_pw_lKeI η23_is_cat_rKe assms, unfold cat_op_simps)
    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    show 
      "op_ntcf (ntcf_id 𝔗) :
        op_cf (LK23 𝔗) ∘CF op_cf 𝔎23 ↦CF.rKeα op_cf 𝔗 :
        op_cat (cat_ordinal (2ℕ)) ↦C op_cat (cat_ordinal (3ℕ)) ↦C
        (HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦C cat_Set α)"
    proof(intro is_cat_rKe_preservesI)
      show 
        "op_ntcf (ntcf_id 𝔗) :
          op_cf (LK23 𝔗) ∘CF op_cf 𝔎23 ↦CF.rKeα op_cf 𝔗 :
          op_cat (cat_ordinal (2ℕ)) ↦C op_cat (cat_ordinal (3ℕ)) ↦C op_cat 𝔄"
      proof(cs_intro_step cat_op_intros)
        show "ntcf_id 𝔗 :
          𝔗 ↦CF.lKeα LK23 𝔗 ∘CF 𝔎23 :
          cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C 𝔄"
          by (intro η23_is_cat_rKe assms)
      qed simp_all
      from prems show "HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦Cα cat_Set α"
        by (cs_concl cs_simp: cs_intro: cat_cs_intros)

      have 
        "op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗 :
          op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF.lKeα
          (op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗) ∘CF 𝔎23 :
          cat_ordinal (2ℕ) ↦C cat_ordinal (3ℕ) ↦C op_cat (cat_Set α)"
      proof(intro is_cat_lKeI')
        show "𝔎23 : cat_ordinal (2ℕ) ↦↦Cα cat_ordinal (3ℕ)"
          by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
        from prems show "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 :
          cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
          by 
            (
              cs_concl
                cs_simp: cat_cs_simps cat_op_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
            )

        from prems show 
          "op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗 :
            op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 
            op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ∘CF 𝔎23 :
            cat_ordinal (2ℕ) ↦↦Cα op_cat (cat_Set α)"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
                cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
            )

        fix 𝔉' η' assume prems':
          "𝔉' : cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
          "η' :
            op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF 𝔎23 :
            cat_ordinal (2ℕ) ↦↦Cα op_cat (cat_Set α)"

        interpret 𝔉': is_functor α ‹cat_ordinal (3ℕ)› ‹op_cat (cat_Set α)› 𝔉'
          by (rule prems'(1))
        interpret η': is_ntcf
          α
          ‹cat_ordinal (2ℕ)›
          ‹op_cat (cat_Set α)›
          ‹op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗› 
          ‹𝔉' ∘CF 𝔎23› 
          η'
          by (rule prems'(2))
        note [unfolded cat_op_simps, cat_cs_intros] = 
          η'.ntcf_NTMap_is_arr'
          𝔉'.cf_ArrMap_is_arr'
        show
          "∃!σ.
            σ :
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α) ∧
            η' = σ ∘NTCF-CF 𝔎23 ∙NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)"
        proof(intro ex1I conjI; (elim conjE)?) 
          have [cat_Kan_cs_simps]:
            "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 =
              LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)"
          proof(rule cf_eqI)
            from prems show lhs: "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 :
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
              by
                (
                  cs_concl
                    cs_simp: cat_op_simps
                    cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                )
            from prems show rhs: "LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) :
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
              by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
            from lhs prems have ObjMap_dom_lhs:
              "𝒟∘ ((op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMap⦈) = 3ℕ"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ObjMap_dom_rhs:
              "𝒟∘ (LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMap⦈) = 3ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show
              "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMap⦈ =
                LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
             fix c assume prems'': "c ∈∘ 3ℕ"
             then consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ› 
               unfolding three by auto
              from this prems 0123 show 
                "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMap⦈⦇c⦈ =
                  LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMap⦈⦇c⦈"
                by (cases; use nothing in ‹simp_all only:›)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps 
                        cat_Kan_cs_simps 
                        cat_cs_simps 
                        cat_op_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                  )+
            qed
              (
                use prems in 
                  ‹
                    cs_concl
                      cs_simp: cat_op_simps 
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                  ›
              )+

            from lhs prems have ArrMap_dom_lhs:
              "𝒟∘ ((op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMap⦈) = 
                cat_ordinal (3ℕ)⦇Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ArrMap_dom_rhs:
              "𝒟∘ (LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMap⦈) =
                cat_ordinal (3ℕ)⦇Arr⦈"
              by (cs_concl cs_simp: cat_cs_simps)

            show
              "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMap⦈ =
                LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              fix f assume "f ∈∘ cat_ordinal (3ℕ)⦇Arr⦈"
              then obtain a' b' where f: "f : a' ↦cat_ordinal (3ℕ) b'" 
                by auto
              from f prems 0123 002 show
                "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMap⦈⦇f⦈ =
                  LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMap⦈⦇f⦈"
                by (elim cat_ordinal_3_is_arrE, (simp_all only:)?)
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps 
                      cs_intro: 
                        cat_ordinal_cs_intros 
                        cat_Kan_cs_intros 
                        cat_cs_intros   
                        cat_op_intros 
                        nat_omega_intros
                  )+
            qed
              (
                use prems in
                  ‹
                    cs_concl 
                      cs_simp: cat_op_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros›
              )+
          
          qed simp_all

          show "LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' : 
            op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' : 
            cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
            by
              (
                cs_concl 
                  cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps 
                  cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
              )

          show "η' =
            LK_σ23
              (
                op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' ∘NTCF-CF
                𝔎23 ∙NTCF 
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
              )"
          proof(rule ntcf_eqI)
            show lhs: "η' :
              op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF 𝔎23 :
              cat_ordinal (2ℕ) ↦↦Cα op_cat (cat_Set α)"
              by (rule prems'(2))
            from lhs have "𝒟∘ (η'⦇NTMap⦈) = cat_ordinal (2ℕ)⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            from prems show rhs: 
              "LK_σ23
                (
                  op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' ∘NTCF-CF 
                  𝔎23 ∙NTCF 
                  (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
                ) : 
              op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF 𝔎23 :
              cat_ordinal (2ℕ) ↦↦Cα op_cat (cat_Set α)"
              by 
                (
                  cs_concl 
                    cs_simp: cat_Kan_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                )
            from lhs have dom_lhs: "𝒟∘ (η'⦇NTMap⦈) = 2ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from rhs have dom_rhs: "𝒟∘ ((LK_σ23
              (
                op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' ∘NTCF-CF 
                𝔎23 ∙NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
              ))⦇NTMap⦈) = 2ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show
              "η'⦇NTMap⦈ =
                (
                  LK_σ23
                    (
                      op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' ∘NTCF-CF
                      𝔎23 ∙NTCF 
                      (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
                    )
                )⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_ordinal_cs_simps)
              fix c assume "c ∈∘ 2ℕ"
              then consider ‹c = 0› | ‹c = 1ℕ› unfolding two by auto
              from this prems 0123 show 
                "η'⦇NTMap⦈⦇c⦈ = 
                  (
                    LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' ∘NTCF-CF 
                    𝔎23 ∙NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
                  )⦇NTMap⦈⦇c⦈"
                by (cases, use nothing in ‹simp_all only:›)
                  (
                    cs_concl
                      cs_simp: 
                        cat_ordinal_cs_simps 
                        cat_Kan_cs_simps 
                        cat_cs_simps 
                        cat_op_simps 
                        𝔎23_ObjMap_app_1 
                        𝔎23_ObjMap_app_0 
                        LK_σ23_NTMap_app_0 
                        cat_Set_components(1) 
                      cs_intro: 
                        cat_Kan_cs_intros 
                        cat_cs_intros 
                        cat_prod_cs_intros 
                        cat_op_intros 
                        𝔗.HomCod.cat_Hom_in_Vset
                  )+
            qed (cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros)+
          qed simp_all

          fix σ assume prems'':
            "σ : 
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' : 
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
            "η' = σ ∘NTCF-CF 𝔎23 ∙NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)"

          interpret σ: is_ntcf 
            α
            ‹cat_ordinal (3ℕ)› ‹op_cat (cat_Set α)› 
            ‹op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗› 
            𝔉' 
            σ
            by (rule prems''(1))

          note [cat_Kan_cs_intros] = σ.ntcf_NTMap_is_arr'[unfolded cat_op_simps]

          from prems''(2) have 
            "η'⦇NTMap⦈⦇0⦈ =
              (
                σ ∘NTCF-CF
                𝔎23 ∙NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
              )⦇NTMap⦈⦇0⦈"
            by simp
          from this prems 0123 have η'_NTMap_app_0: "η'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
            by (*very slow*) 
              (
                cs_prems 
                  cs_simp: 
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps 
                    cat_cs_simps 
                    cat_op_simps 
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros 
                    cat_cs_intros 
                    cat_prod_cs_intros
                    cat_op_intros 
                    𝔗.HomCod.cat_Hom_in_Vset
              )

          from prems''(2) have 
            "η'⦇NTMap⦈⦇1ℕ⦈ =
              (
                σ ∘NTCF-CF
                𝔎23 ∙NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
              )⦇NTMap⦈⦇1ℕ⦈"
            by simp
          from this prems 0123 have η'_NTMap_app_1: "η'⦇NTMap⦈⦇1ℕ⦈ = σ⦇NTMap⦈⦇2ℕ⦈"
            by (*very slow*) 
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_op_simps
                    cat_Set_components(1)
                  cs_intro:
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )+

          from 0123 have 013: "[0, 1ℕ]∘ : 0 ↦cat_ordinal (3ℕ) 1ℕ"
            by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
          from 0123 have 00: "[0, 0]∘ = (cat_ordinal (2ℕ))⦇CId⦈⦇0⦈"
            by (cs_concl cs_simp: cat_ordinal_cs_simps)

          from σ.ntcf_Comp_commute[OF 013] prems 0123 013
          have [cat_Kan_cs_simps]:
            "σ⦇NTMap⦈⦇1ℕ⦈ = η'⦇NTMap⦈⦇0⦈ ∘Acat_Set α 𝔉'⦇ArrMap⦈⦇0, 1ℕ⦈∙"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_op_simps
                    LK23_ArrMap_app_01
                  cs_intro: 
                    cat_ordinal_cs_intros
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
                    nat_omega_intros
                  cs_simp: 00 η'_NTMap_app_0[symmetric]
              )

          show "σ = LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉'"
          proof(rule ntcf_eqI)
            show lhs: "σ :
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
              by (rule prems''(1))
            show rhs: "LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉' : 
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3ℕ) ↦↦Cα op_cat (cat_Set α)"
              by
                (
                  cs_concl
                    cs_simp: cat_Kan_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from lhs have dom_lhs: "𝒟∘ (σ⦇NTMap⦈) = 3ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from rhs have dom_rhs:
              "𝒟∘ (LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉'⦇NTMap⦈) = 3ℕ"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)

            show "σ⦇NTMap⦈ = LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉'⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume "c ∈∘ 3ℕ"
              then consider ‹c = 0› | ‹c = 1ℕ› | ‹c = 2ℕ› 
                unfolding three by auto
              from this 0123 show 
                "σ⦇NTMap⦈⦇c⦈ =
                  LK_σ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) η' 𝔉'⦇NTMap⦈⦇c⦈"
                by (cases, use nothing in ‹simp_all only:›)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps
                        cat_cs_simps
                        cat_Kan_cs_simps
                        cat_op_simps
                        η'_NTMap_app_0
                        LK_σ23_NTMap_app_0
                        η'_NTMap_app_1
                      cs_intro: 
                        cat_ordinal_cs_intros
                        cat_Kan_cs_intros
                        cat_cs_intros
                        cat_op_intros
                        nat_omega_intros
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+

          qed simp_all

        qed

      qed

      then have 
        "op_ntcf (HomO.Cα𝔄(-,a) ∘CF-NTCF op_ntcf (ntcf_id 𝔗)) :
          op_cf (HomO.Cα𝔄(-,a) ∘CF op_cf 𝔗) ↦CF.lKeα
          op_cf ((HomO.Cα𝔄(-,a) ∘CF op_cf (LK23 𝔗))) ∘CF op_cf (op_cf 𝔎23) :
          op_cat (op_cat (cat_ordinal (2ℕ))) ↦C
          op_cat (op_cat (cat_ordinal (3ℕ))) ↦C
          op_cat (cat_Set α)"
        by
          (
            cs_concl
              cs_simp: cat_op_simps 
              cs_intro: cat_cs_intros cat_Kan_cs_intros cat_op_intros
          )
      from is_cat_lKe.is_cat_rKe_op[OF this] prems show
        "HomO.Cα𝔄(-,a) ∘CF-NTCF op_ntcf (ntcf_id 𝔗) :
          (HomO.Cα𝔄(-,a) ∘CF op_cf (LK23 𝔗)) ∘CF op_cf 𝔎23 ↦CF.rKeα
          HomO.Cα𝔄(-,a) ∘CF op_cf 𝔗 :
          op_cat (cat_ordinal (2ℕ)) ↦C 
          op_cat (cat_ordinal (3ℕ)) ↦C
          cat_Set α"
        by
          (
            cs_prems
              cs_simp: cat_op_simps 
              cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

text‹\newpage›

end

Theory CZH_UCAT_Conclusions

(* Copyright 2021 (C) Mihails Milehins *)

theory CZH_UCAT_Conclusions
  imports 
    CZH_UCAT_Universal
    CZH_UCAT_Limit
    CZH_UCAT_Complete
    CZH_UCAT_Adjoints
    CZH_UCAT_Kan
    CZH_UCAT_PWKan
    CZH_UCAT_PWKan_Example
begin
end